home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 033a / alia173c.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1991-09-01  |  136KB  |  3,977 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS 17.3C, Copyright 1986 - 91 by D. Thomas Mack'
  3. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990; Sept 1, 1991
  7. '  Copyright ..........: 1986 - 1991
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  Macro          1320  Check/execute macro
  18. '  AnswerIt        200  Answer the telephone when it rings
  19. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  20. '  BadChar         455  Check user name for invalid characters
  21. '  BadName       20235  Check for system crash attempt with bad file name
  22. '  Baud450        5507  Allow 300 baud callers to bump up to 450 baud
  23. '  CheckRatio    20096  Test upload/download ratio
  24. '  CheckMacro     1242  Checks for macro and processes
  25. '  CopyRight        97  Display RBBS-PC's copyright notice
  26. '  DEFALTU        9600  Write out the user's defaults
  27. '  DenyAccess     1386  Downgrade security so access denied
  28. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  29. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  30. '  EditALine      2618  Edits a single line
  31. '  EditDef         120  Edit configuration parameters
  32. '  FileNameCheck 20240  Matches file name to a prefix & extension
  33. '  GetArc        20140  Handle request for verbose listing
  34. '  GetCommand      101  Get RBBS-PC's node id from command line
  35. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  36. '  GoIdle           90  Release resources when waiting for keyboard input
  37. '  KillMsg        3952  Delete old or unnecessary messages
  38. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  39. '  LineEdit       3700  Edit a line while minimizing string space consumption
  40. '  LogError      13660  Log error message to CALLERS file
  41. '  LPrnt          1480  Subroutine to write to local display
  42. '  MLInit            8  Handle MultiLink initialization/de-initialization
  43. '  MsgProt        2055  Sets protection for a message
  44. '  MessageTo      2018  Sets who a message is to
  45. '  PageLen        5200  Change page length
  46. '  ParseIt        1637  Parses a string
  47. '  PassWrd         660  Verify user & message passwords
  48. '  PopCmdStack    1650  Get user input, 1st checking command stack
  49. '  PScrn          1483  Print to display
  50. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  51. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  52. '  QuickTPut1     1478  Outputs short string following by CR LF
  53. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  54. '  RecoverMsg    10410  Recover a deleted message
  55. '  RemNonAlf      5100  Removes non-alpha characters from a string
  56. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  57. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  58. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  59. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  60. '  SetThread      4554  Set up request for threading thru messages
  61. '  SkipLine       1485  Write a # of blank lines to the communications port
  62. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  63. '  SecViolation   1380  Process a security violation
  64. '  SysMenu         112  Displays sysop menu/status
  65. '  SysopChat      4773  Sysop and caller chat
  66. '  TestRel         336  Tests for Reliable connect
  67. '  TGet           1498  Read a line from the communications port
  68. '  TPut           1396  Write a line to the communications port
  69. '  Trim            105  Strip leading and trailing blanks from a string
  70. '  TrimTrail       107  Strip off specified string off end of another string
  71. '  UntilRight    12878  Ask a question until user says answer is right
  72. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  73. '  VarInit         109  Initialize system variables
  74. '  ViewHelp       1330  Processes help command
  75. '  WhoCheck       2250  Checks whether a user exists in user file
  76. '  WhosOn         9801  Report status of each node - who's on
  77. '  WordInFile    10976  Find a whole word within a file/menu
  78. '
  79. '  $INCLUDE: 'RBBS-VAR.BAS'
  80. '
  81. 8 '  $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization'
  82. '  $PAGE
  83. '
  84. '  NAME    -- MLInit
  85. '
  86. '  INPUTS  --  MLParm = 1             INITIALIZE AT STARTUP OR RE-
  87. '                                     CYLCE TIME
  88. '              MLParm = 2             DE-INITIALIZE ON EXITING TO
  89. '                                     A DOOR OR DOS REMOTELY
  90. '              MLParm = 3             DE-QUEUE COMMUNICATIONS PORTS
  91. '              MLParm = 4             CHECK FOR MULTILINK PRESENT
  92. '              ZDoorsTermType
  93. '              ZBaudTest!
  94. '              ZComPort$
  95. '              ZComputerType
  96. '
  97. '  OUTPUTS --  NONE
  98. '
  99. '  PURPOSE --  To test for the presence of multi-link and set
  100. '              multi link options to be compatible with RBBS-PC
  101. '
  102.       SUB MLInit (MLParm) STATIC
  103.     DEF SEG = 0
  104.     IF ZComputerType = 1 _
  105.        GOTO 10
  106.     IF NOT ZMLCom THEN _
  107.        IF ZNetworkType <> 1 THEN _
  108.           GOTO 10
  109.     ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  110.     IF ZMultiLinkPresent = 0 THEN _
  111.        GOTO 10
  112.     ON MLParm GOSUB 30,20,60,10
  113. 10  DEF SEG
  114.     EXIT SUB
  115. 20  IF ZDoorsTermType < 1 THEN _
  116.        RETURN
  117.     DEF SEG = ZMultiLinkPresent
  118.     GOSUB 60
  119. ' **************     MLUTIL BAUD n (where n = ZBaudTest!)  ******
  120.     WasAX = &H600
  121.     WasBX = ZBaudTest!   ' Tell ML the baud rate
  122.     GOSUB 80
  123. ' **************     MLUTIL TERM n (where n = ZDoorsTermType) ****
  124.     WasAX = &H700 + ZDoorsTermType
  125.     GOSUB 80         ' Tell ML the terminal type
  126. ' *********          MLINK /port       ***********
  127. '                    ' Tell ML the communications port
  128.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(ZComPort$,1)) - 48
  129. ' ************       MLUTIL SCMON       *************
  130.     WasAX = &HB01
  131.     WasBX = 0           ' Tell ML to start monitoring the carrier
  132.     GOSUB 80
  133.     RETURN
  134. ' **************     MLUTIL CCMON       ***************
  135. 30  WasAX = &HB00       ' Turn off ML's carrier monitoring.
  136.     WasBX = 0
  137.     GOSUB 80
  138. ' **************     MLUTIL TERM 1       *************
  139.     WasAX = &H701       ' Change terminal type to ML type 1.
  140.     WasBX = 0
  141.     GOSUB 80
  142. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  ******
  143. ' *******            port = 0 if ML 4.00 or greater           ******
  144.     DEF SEG = ZMultiLinkPresent
  145.     MultiLinkCommPort = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  146.     MultiLinkVersion = PEEK(&H1) + 256 * PEEK(&H2)
  147.     IF PEEK(MultiLinkCommPort) = &H1 OR _
  148.        PEEK(MultiLinkCommPort) = &H2 THEN _
  149.        IF MultiLinkVersion > 5000 THEN _
  150.           POKE (MultiLinkCommPort),&H0 _
  151.        ELSE POKE (MultiLinkCommPort),&H9
  152. ' **********         MLUTIL ENQ         **********
  153.     WasAX = &H1        ' Tell ML to conditional enque on the comm. port
  154.     GOSUB 70
  155. ' **********         MLUTIL BAUD 19200      *********
  156.     WasAX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  157.     WasBX = 19200
  158.     GOSUB 80
  159.     RETURN
  160. ' **********         MLUTIL DEQ         *********
  161. 60 WasAX = &H100        ' Tell ML to unconditionally deque the comm. port
  162. 70 WasBX = -4
  163.    IF ZComPort$ = "COM2" THEN _
  164.       WasBX = -3
  165.    IF ZComPort$ = "COM0" THEN _
  166.       RETURN
  167. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  *******
  168. 80 CALL RBBSML(WasAX,WasBX)
  169.    RETURN
  170.    END SUB
  171. 90 '  $SUBTITLE: 'GoIdle - release control when waiting'
  172. '  $PAGE
  173. '
  174. '  NAME    -- GoIdle
  175. '
  176. '  INPUTS  -- ZMLCom
  177. '             ZNetworkType
  178. '
  179. '  OUTPUTS --  NONE
  180. '
  181. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  182. '              input from the communications port
  183. '
  184.       SUB GoIdle STATIC
  185.    IF ZMLCom OR ZNetworkType = 1 THEN _
  186.       CALL MLInit(5) : _
  187.       EXIT SUB
  188.    CALL GiveBack
  189.    END SUB
  190. 97 '  $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
  191. '  $PAGE
  192. '
  193. '  NAME    -- CopyRight
  194. '
  195. '  INPUTS  --  NONE
  196. '
  197. '  OUTPUTS --  NONE
  198. '
  199. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  200. '
  201.       SUB CopyRight STATIC
  202.    ZWasA = (ZRecycleToDos OR ZDebug OR ZExitToDoors OR ZNodeRecIndex > 2)
  203.    IF ZWasA THEN _
  204.       EXIT SUB
  205.    WIDTH 80
  206.    ZOutTxt$(1) = "If you use RBBS-PC 17.3C, consider becoming a member of"
  207.    ZOutTxt$(2) = ""
  208.    ZOutTxt$(3) = "               Capital PC User Group"
  209.    ZOutTxt$(4) = "          51 Monroe Street - Plaza East Two"
  210.    ZOutTxt$(5) = "             Rockville, Maryland  20850"
  211.    ZOutTxt$(6) = ""
  212.    ZOutTxt$(7) = "You are free to copy/share RBBS-PC 17.3C provided"
  213.    ZOutTxt$(08)= "  1.  This program is distributed unmodified"
  214.    ZOutTxt$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  215.    ZOutTxt$(10)= "  3.  This notice is not bypassed or removed."
  216.    CLS
  217.    KEY OFF
  218.    LOCATE ,,0
  219.    ZWasA = ZSnoop
  220.    ZSnoop = -1
  221.    CALL LPrnt(SPACE$(60) + "tm",1)
  222.    CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  223.    CALL SkipLine(1)
  224.    CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  225.    CALL SkipLine (1)
  226.    CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  227.    FOR WasI = 1 TO 10
  228.       CALL LPrnt(SPACE$(5) + CHR$(186) + "    " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1)
  229.    NEXT
  230.    CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  231.    CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-91 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  232.    CALL DelayTime (8)
  233.    ZSnoop = ZWasA
  234.    END SUB
  235. 101 ' $SUBTITLE: 'GetCommand - sub to get command from command line'
  236. ' $PAGE
  237. '
  238. '  NAME    -- GetCommand
  239. '
  240. '  INPUTS  --     PARAMETER                    MEANING
  241. '             ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE TO
  242. '                                  USE AS A MODEL WHEN CREATING THE
  243. '                                  .DEF FILE NAME TO BE USED BY THIS
  244. '                                  COPY OF RBBS-PC.
  245. '
  246. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  247. '                                  RBBS-PC IN THE FORM:
  248. '
  249. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  250. '
  251. '   WHERE THE OPTIONAL PARAMETERS ARE:
  252. '
  253. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  254. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  255. ' DEBUG    IS A DEBUGGING Switch
  256. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  257. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  258. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  259. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  260. '             PROGRAM
  261. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  262. '
  263. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  264. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  265. '
  266. '  OUTPUTS -- ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE FOR
  267. '                                  THIS COPY OF RBBS-PC TO USE
  268. '             ZNodeRecIndex    RECORD NUMBER WITHIN THE
  269. '                                  MESSAGES FILE FOR THIS "NODE"
  270. '                                  (RANGE IS 2 TO 36)
  271. '
  272. '  PURPOSE --  To get node id from command line and determine if rbbs
  273. '              is being run as a door
  274. '
  275.       SUB GetCommand (PassedDebug,NetTime$,ZNetBaud$,ZNetReliable$) STATIC
  276.       STATIC ZDebug
  277. '
  278. '
  279. ' *  GET NODE ID FROM COMMAND LINE
  280. '
  281. '
  282.       WasPM$ = COMMAND$
  283.       CALL AllCaps(WasPM$)
  284.       IF INSTR(WasPM$,"/") = 0 THEN _
  285.          GOTO 103
  286. '
  287. '
  288. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  289. '
  290. '
  291.       CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/"))
  292.       WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1)
  293.       ZWasA = 0
  294.       FOR WasX = 1 TO LEN(CmdLine$)
  295.           IF MID$(CmdLine$,WasX,1) = "/" THEN _
  296.              ZWasA = ZWasA + 1 : _
  297.              ZSubDir$(ZWasA) = "" _
  298.           ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1)
  299.       NEXT
  300.       NetTime$ = ZSubDir$(1)
  301.       IF ZWasA > 1 THEN _
  302.          ZNetBaud$ = ZSubDir$(2)
  303.       IF ZWasA > 2 THEN _
  304.          ZNetReliable$ = ZSubDir$(3)
  305.       CALL Trim(NetTime$)
  306.       CALL Trim(ZNetBaud$)
  307.       CALL Trim(ZNetReliable$)
  308. 103   ZWasA = INSTR(WasPM$,"DEBUG")
  309.       IF ZWasA > 0 THEN _
  310.          ZDebug = -1 : _
  311.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  312.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  313.       PassedDebug = ZDebug
  314.       ZWasA = INSTR(WasPM$,"LOCAL")
  315.       IF ZWasA > 0 THEN _
  316.          ZComPort$ = "COM0" : _
  317.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  318.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  319.       IF LEN(WasPM$) = 0 THEN _
  320.          WasPM$ = "-"
  321.       ZNodeRecIndex = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(WasPM$,1))
  322.       IF ZNodeRecIndex < 2 THEN _
  323.          ZNodeRecIndex = 2
  324.       ZNodeID$ = MID$(STR$(ZNodeRecIndex-1),2)
  325.       IF ZNodeRecIndex > 10 THEN _
  326.          ZNodeFileID$ = LEFT$(WasPM$,1) _
  327.       ELSE ZNodeFileID$ = ZNodeID$
  328.       IF ZNodeID$ <> "1" THEN _
  329.          ZLibNodeID$ = ZNodeFileID$
  330.       IF LEN(WasPM$) > 2 AND MID$(WasPM$,2,1) = " " THEN _
  331.          ZConfigFileName$ = MID$(WasPM$,3)_
  332.       ELSE MID$(ZConfigFileName$,5,1) = WasPM$
  333.       ZOrigCnfg$ = ZConfigFileName$
  334.       END SUB
  335. 105 ' $SUBTITLE: 'Trim - sub to eliminate leading/trailing blanks'
  336. ' $PAGE
  337. '
  338. '  NAME    -- Trim
  339. '
  340. '  INPUTS  --  PARAMETER                    MEANING
  341. '              TrimParm$           STRING THAT IS TO HAVE LEADING
  342. '                                  AND TRAILING BLANKS ELIMINATED FROM
  343. '
  344. '  OUTPUTS --  TrimParm$           STRING WITH NO LEADING OR TRAILING
  345. '                                   BLANKS
  346. '
  347. '  PURPOSE --  To strip leading and trailing blanks
  348. '
  349.       SUB Trim (TrimParm$) STATIC
  350.       WasL = INSTR(TrimParm$," ")
  351.       IF WasL < 1 THEN _
  352.          EXIT SUB
  353.       IF WasL = 1 THEN _
  354.          WHILE LEFT$(TrimParm$,1) = " " : _
  355.             TrimParm$ = RIGHT$(TrimParm$,LEN(TrimParm$) - 1) : _
  356.          WEND
  357.       CALL TrimTrail (TrimParm$," ")
  358.       END SUB
  359. '
  360. 107 '  $SUBTITLE: 'TrimTrail - sub to trim off trailing characters'
  361. '  $PAGE
  362. '
  363. '  NAME    --  TrimTrail
  364. '
  365. '  INPUTS  --  PARAMETER           MEANING
  366. '              TrimParm$  WHAT STRING TO Trim FROM
  367. '              TrimThis$  WHAT CHARACTER TO Trim OFF END
  368. '
  369. '  OUTPUTS --  NONE
  370. '
  371. '  PURPOSE --  To remove all occurences of a character from end of string
  372. '
  373.       SUB TrimTrail (TrimParm$,TrimThis$) STATIC
  374.       IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN _
  375.          EXIT SUB
  376.       WasJ = LEN(TrimParm$) - 1
  377. 108   IF WasJ > 0 THEN _
  378.          IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN _
  379.             WasJ = WasJ - 1 : _
  380.             GOTO 108
  381.       TrimParm$ = LEFT$(TrimParm$, WasJ)
  382.       END SUB
  383. '
  384. 109 '  $SUBTITLE: 'VarInit - subroutine to initialize system variables'
  385. '  $PAGE
  386. '
  387. '  NAME    --  VarInit
  388. '
  389. '  INPUTS  --  PARAMETER           MEANING
  390. '              NONE
  391. '
  392. '  OUTPUTS --  NONE
  393. '
  394. '  PURPOSE --  To initialize system variable
  395. '
  396.       SUB VarInit STATIC
  397.     ZAcknowledge$ = CHR$(6)
  398.     ZAckChar$ = "C" + _
  399.             ZAcknowledge$
  400.     ZActiveMenu$ = "B"
  401.     ZActiveMessage$ = CHR$(225)
  402.     ZBackSpace$ = CHR$(8) + _
  403.                  CHR$(32) + _
  404.                  CHR$(8)
  405.     ZBackArrow$ = CHR$(29) + _
  406.                   CHR$(32) + _
  407.                   CHR$(29)
  408.     ZBaudRates$ = "      300  450 1200 2400 4800 96001920038400"
  409.     ZBellRinger$ = CHR$(7)
  410.     ZBulletinMenu$ = ""
  411.     ZWasCL = 24
  412.     ZCancel$ = CHR$(24)
  413.     ZColorReset$ = CHR$(27) + _
  414.                    "[00;37;40m"
  415.     ZConfigFileName$ = "RBBS-PC.DEF"
  416.     ZCarriageReturn$ = CHR$(13)
  417.     ZDeletedMsg$ = CHR$(226)
  418.     ZEndTransmission$ = CHR$(4)
  419.     ZEscape$ = CHR$(27)
  420.     ZExpectActiveModem = 0
  421.     ZFalse = 0
  422.     ZF1Key = 59
  423.     ZF10Key = 68
  424.     ZConfName$ = "MAIN"
  425.     CALL SetHiLite (ZTrue)
  426.     ZHomeConf$ = ""
  427.     ZInConfMenu = -1
  428.     ZLastCommand$ = "M "
  429.     ZLimitMinsPerSession = 0
  430.     ZLineFeed$ = CHR$(10)
  431.     ZLineFeeds = NOT ZFalse
  432.     ZLineEditChk$ = CHR$(9) + _
  433.                     ZLineFeed$ + _
  434.                     CHR$(11) + _
  435.                     CHR$(12) + _
  436.                     CHR$(127) + _
  437.                     CHR$(8) + _
  438.                     ZBellRinger$ + _
  439.                     CHR$(26) + _
  440.                     CHR$(227)
  441.     ZLineMes$ = SPACE$(78)          ' fixed length string workspace
  442.     ZLockStatus$ = "UM UU UB UD"
  443.     ZMenuIndex = 2
  444.     ZNAK$ = CHR$(21)
  445.     ZNoAdvance = ZFalse
  446.     ZPageLength = 23
  447.     ZParseOff = ZFalse
  448.     ZPressEnter$ = " (Press [ENTER] to quit)"
  449.     ZPressEnterExpert$ = " ([ENTER] quits)"
  450.     ZPressEnterNovice$ = ZPressEnter$
  451.     ZPrivateDoor = ZFalse
  452.     ZRightMargin = 72
  453.     ZReturnLineFeed$ = ZCarriageReturn$ + _
  454.                         ZLineFeed$
  455.     ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  456.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
  457.                    "TY TN BN ND FS LS"
  458.     ZStartOfHeader$ = CHR$(1)
  459.     ZTimeLoggedOn$ = SPACE$(8)
  460.     ZTrue = NOT ZFalse
  461.     ZUpInc = -1
  462.     ZXOff$ = CHR$(19)
  463.     ZXOn$ = CHR$(17)
  464.     ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
  465.     ZOptionEnd$ = ZReturnLineFeed$ + " ,("
  466.     ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
  467.     ZWasLG$(1) = "Registration Check Failed"
  468.     ZWasLG$(2) = "Sysop name attempted"
  469.     ZWasLG$(3) = "Locked out attempt"
  470.     ZWasLG$(4) = "Password Attempt Failed"
  471.     ZWasLG$(5) = "Auto Lockout done"
  472.     ZWasLG$(6) = "Name in use on another Node!"
  473.     ZWasLG$(7) = ""
  474.     ZWasLG$(8) = "Locked reason read!"
  475.     ZWasLG$(9) = "Expired Registration"
  476.     END SUB
  477. '
  478. 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu'
  479. '  $PAGE
  480. '
  481. '  NAME    --  SysMenu
  482. '
  483. '  INPUTS  --  PARAMETER           MEANING
  484. '
  485. '  OUTPUTS --  NONE
  486. '
  487. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  488. '
  489.     SUB SysMenu STATIC
  490.     ZLocalUser = ZTrue
  491.     ZSnoop = ZTrue
  492.     ZNonStop = ZTrue
  493.     CALL CheckTime (TIMER, ZDelay!, 1)
  494.     CLS
  495.     ZStopInterrupts = ZTrue
  496.     ZBypassTimeCheck = ZTrue
  497.     CALL BufFile ("MENU0",WasX)
  498.     ZNonStop = ZFalse
  499.     ZBypassTimeCheck = ZFalse
  500.     ZLocalUser = ZFalse
  501.     IF NOT ZOK THEN _
  502.        CALL LPrnt("MENU0 not on default drive",1)
  503.     LOCATE 2,13
  504.     CALL LPrnt(LEFT$(ZVersionID$,13),0)
  505.     LOCATE 2,42
  506.     CALL LPrnt(ZNodeID$,0)
  507.     LOCATE 2,60
  508.     WasX$ = DATE$
  509.     CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0)
  510.     LOCATE 2,74
  511.     CALL LPrnt(LEFT$(TIME$,5),0)
  512.     IF ZFMSDirectory$ <> "" THEN _
  513.        LOCATE 6,76 : _
  514.        CALL LPrnt("YES",0)
  515.     IF ZExtendedLogging THEN _
  516.        LOCATE 8,76 : _
  517.        CALL LPrnt("YES",0)
  518.     IF ZFossil THEN _
  519.        LOCATE 10,76 : _
  520.        CALL LPrnt("YES",0)
  521.     LOCATE 12,75 : _
  522.     CALL LPrnt(ZComPort$,0)
  523.     LOCATE 14,75
  524.     CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0)
  525.     IF ZDebug THEN _
  526.        LOCATE 22,76 : _
  527.        CALL LPrnt("Yes",0)
  528.     END SUB
  529. '
  530. 120 '  $SUBTITLE: 'EditDef - sub to edit config parameters'
  531. '  $PAGE
  532. '
  533. '  NAME    -- EditDef
  534. '
  535. '  INPUTS  --     PARAMETER                    MEANING
  536. '
  537. '  OUTPUTS --                          OUTPUT STRING
  538. '
  539. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  540. '
  541.       SUB EditDef STATIC
  542.       ZAllOpts$ = ZMainCmds$ + _
  543.                   ZFileCmd$ + _
  544.                   ZUtilCmds$ + _
  545.                   ZLibCmds$ + _
  546.                   ZGlobalCmnds$ + _
  547.                   ZSysopCmds$
  548.       ZHelpExtension$ = "." + _
  549.                         ZHelpExtension$
  550.       ZCompressedExt$ = ZDefaultExtension$
  551.       ZWasQ = INSTR(ZDefaultExtension$,".")
  552.       IF ZWasQ > 0 THEN _
  553.          ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1)
  554.       ZCurDirPath$ = ZDirPath$
  555.       ZBegMain = 1
  556.       ZBegFile = LEN(ZMainCmds$) + ZBegMain
  557.       ZBegUtil = LEN(ZFileCmd$) + ZBegFile
  558.       ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil
  559.       ZHelp$(3) = ZHelpPath$ + _
  560.                  ZHelp$(3)
  561.       ZHelp$(4) = ZHelpPath$ + _
  562.                  ZHelp$(4)
  563.       ZHelp$(7) = ZHelpPath$ + _
  564.                  ZHelp$(7)
  565.       ZHelp$(9) = ZHelpPath$ + _
  566.                  ZHelp$(9)
  567.       CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_
  568.                      Extension$,ZTrue)
  569.      CALL ASCIICodes ("[","]",ZDefaultLineACK$)
  570.      CALL ASCIICodes ("[","]",ZHostEchoOn$)
  571.      CALL ASCIICodes ("[","]",ZHostEchoOff$)
  572.      CALL ASCIICodes ("[","]",ZEmphasizeOffDef$)
  573.      CALL ASCIICodes ("[","]",ZEmphasizeOnDef$)
  574.      ZDR1$ = ZFG1Def$
  575.      ZDR2$ = ZFG2Def$
  576.      ZDR3$ = ZFG3Def$
  577.      ZDR4$ = ZFG4Def$
  578.      IF ZSubParm = -62 THEN _
  579.         EXIT SUB
  580.      ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
  581.      IF ZLocalUserMode THEN _
  582.         ZRecycleToDos = ZTrue
  583.      ZEchoer$ = ZDefaultEchoer$
  584.      IF LEN(ZScreenOutMsg$) < 2 THEN _
  585.         ZScreenOutMsg$ = ZStartOfHeader$
  586.      ZSmartTextCode$ = CHR$(ZSmartTextCode)
  587.      IF ZMaxWorkVar < 13 THEN _
  588.         ZMaxWorkVar = 13
  589. '
  590. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  591. '
  592.     IF ZMainFMSDir$ <> "" THEN _
  593.        ZFMSDirectory$ = ZDirPath$ + _
  594.                         ZMainFMSDir$ + _
  595.                         "." + _
  596.                         ZMainDirExtension$ : _
  597.        ZActiveFMSDir$ = ZFMSDirectory$ : _
  598.        ZLibDir$ = ZLibDirPath$ + _
  599.                             ZMainFMSDir$ + _
  600.                             "." + _
  601.                             ZLibDirExtension$
  602.     ZUpcatHelp$ = ZHelpPath$ + _
  603.                   ZUpcatHelp$ + _
  604.                   ZHelpExtension$
  605.     IF ZSubDirCount < 1 THEN _
  606.        GOTO 123
  607.     FOR ZSubDirIndex = 1 TO ZSubDirCount
  608.        INPUT #2,ZSubDir$
  609.        IF RIGHT$(ZSubDir$,1) <> "\" THEN _
  610.          ZSubDir$(ZSubDirIndex) = ZSubDir$ + _
  611.                                  "\" _
  612.        ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$
  613.     NEXT
  614.     GOTO 125
  615. 123 FOR ZSubDirIndex = 1 TO LEN(ZDnldDrives$) - 1
  616.        ZSubDir$(ZSubDirIndex) = MID$(ZDnldDrives$,ZSubDirIndex,1) + _
  617.                                ":"
  618.     NEXT
  619.     ZSubDirCount = LEN(ZDnldDrives$) - 1
  620. '
  621. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ***
  622. '
  623. 125 ZUpldDirCheck$ = ZUpldDir$
  624.     ZSubDirCount = ZSubDirCount + 1
  625.     IF ZUpldToSubdir THEN _
  626.        ZSubDir$(ZSubDirCount) = ZUpldSubdir$ + _
  627.                                "\" _
  628.     ELSE ZSubDir$(ZSubDirCount) = RIGHT$(ZDnldDrives$,1) + _
  629.                                  ":"
  630.     ZUpldDir$ = ZUpldDir$ + _
  631.                         "." + _
  632.                         ZMainDirExtension$
  633.     CALL SearchArray (ZSubDir$(ZSubDirCount),ZSubDir$(),ZSubDirCount-1,Found)
  634.     ZCanDnldFromUp = (Found > 0)
  635.     ZUpldDir$ = ZUpldPath$ + _
  636.                         ZUpldDir$
  637. 126 CLOSE #2
  638.     IF ZLibDrive$ <> "" THEN _
  639.        ZLibType = 1
  640.     ZSubParm = -10
  641.     CALL Carrier
  642.     IF ZSubParm = -1 THEN _
  643.        IF ZLibDrive$ <> "" THEN _
  644.           CALL ChangeDir (ZLibDrive$ + _
  645.                          "\") : _
  646.           CALL KillWork (ZLibWorkDiskPath$ + _
  647.                         ZLibNodeID$ + _
  648.                         "DK*.ARC") : _
  649.                         ZErrCode = 0
  650. '
  651. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  652. '
  653. 128 IF ZNetworkType = 2 THEN _
  654.        ZWasCN$ = SPACE$(535) : _
  655.        CALL InitIO(ZWasA)
  656.        END SUB
  657. '
  658. 129 '  $SUBTITLE: 'ASCIICodes - subrotuine to allow any ASCII codes'
  659. '  $PAGE
  660. '
  661. '  NAME    -- ASCIICodes
  662. '
  663. '  INPUTS  --     PARAMETER                    MEANING
  664. '                 LeftParen$           MARKS BEGINNING OF #
  665. '                 RightParen$          MARKS END OF #
  666. '                 Strng$                INPUT STRING
  667. '
  668. '  OUTPUTS --    Strng$                OUTPUT STRING
  669. '
  670. '  PURPOSE -- To allow a config string to have any ascii values.
  671. '             characters not enclosed taken as is.  Enclosed
  672. '             characters interpreted as value of ascii code.
  673. '             (e.g. "123[32]4" is interpreted as "123 4").
  674. '
  675.     SUB ASCIICodes (LeftParen$,RightParen$,Strng$) STATIC
  676.     IF LEN(Strng$) < 1 THEN _
  677.        EXIT SUB
  678.     Start = 1
  679.     WasL = LEN(Strng$)
  680.     ZUserIn$ = Strng$ + _
  681.          LeftParen$
  682.     WasX = INSTR(ZUserIn$,LeftParen$)
  683.     NewString$ = ""
  684.     WHILE Start <= WasL
  685.        NewString$ = NewString$ + _
  686.                     MID$(ZUserIn$,Start,WasX - Start)
  687.        WasY = INSTR(WasX,ZUserIn$,RightParen$)
  688.        IF WasY > 0 THEN _
  689.           WasK = VAL(MID$(ZUserIn$,WasX + 1,WasY - WasX - 1)) : _
  690.           NewString$ = NewString$ + _
  691.                        CHR$(WasK) : _
  692.           Start = WasY + 1 _
  693.        ELSE NewString$ = NewString$ + _
  694.                          MID$(ZUserIn$,WasX,WasL + 1 - WasX) : _
  695.             Start = WasL + 1
  696.        WasX = INSTR(Start,ZUserIn$,LeftParen$)
  697.     WEND
  698.     Strng$ = NewString$
  699.     END SUB
  700. 200 ' $SUBTITLE: 'AnswerIt - sub to establish connection'
  701. ' $PAGE
  702. '
  703. '  NAME    -- AnswerIt
  704. '
  705. '  INPUTS  --     PARAMETER                    MEANING
  706. '                 ZSubParm = 1           WAIT FOR PHONE TO RING
  707. '                          = 2           CONTINUE LOOKING FOR CONNECT
  708. '                          = 3           RENTRY AFTER FUNCTION KEY
  709. '                          = 4           GO ON LINE IMMEDIATELY
  710. '                 ZBG                    LOCAL DISPLAY'S BACKGROUND
  711. '                 ZBorder                LOCAL DISPLAY'S BORDER COLOR
  712. '                 ZComPort$              COMMUNICATIONS PORT NAME
  713. '                 ZComputerType          TYPE OF COMPUTER RUNNING ON
  714. '                 ZDumbModem             NON-HAYES TYPE MODEM FLAG
  715. '                 ZExtendedLogging       EXTENDED CALLERS LOG FLAG
  716. '                 ZFG                    LOCAL DISPLAY'S FOREGROUND
  717. '                 ZModemAnswerCmd$       COMMAND TO ANSWER PHONE
  718. '                 ZModemCntlReg          LOCATION WasOF MODEM CNTRL. REG
  719. '                 ZModemCountRingsCmd$   COMMAND TO COUNT PHONE RINGS
  720. '                 ZModemInitBaud$        BAUD AT WHICH TO OPEN COMM.
  721. '                 ZModemResetCmd$        COMMAND TO RESET THE MODEM
  722. '                 ZModemStatusReg        LOCATION OF MODEM STATUS REG
  723. '                 ZPrinter               FLAG TO PRINT ON LOCAL PRT.
  724. '                 ZRequiredRings         NUMBER OF RINGS TO ANSWER ON
  725. '                 ZSnoop                 FLAG TO DISPLAY ON LOCAL PC
  726. '                 ZSysopNext             FLAG TO GIVE SYSOP CONTROL
  727. '
  728. '  OUTPUTSS --    BaudTest!              BAUD RATE TO SET RS232 AT
  729. '                 ZEightBit              PARITY INDICATOR
  730. '                 ZReliableMode          INDICATES MODEM-SUPPLIED
  731. '                                        "ERROR-FREE" Protocol ACTIVE
  732. '                 ZSubParm          = 1  Carrier DETECT Found (I.E.
  733. '                                        MODEM AUTO-ANSWERED).
  734. '                                   = 2  ANSWERED THE PHONE AND
  735. '                                        Carrier DETECT OCCURRED.
  736. '                                   = 3  SYSOP HIT "ESC" KEY ON THE
  737. '                                        LOCAL KEYBOARD.
  738. '                                   = 4  ANSWERED THE PHONE BUT NO
  739. '                                        Carrier WAS DETECTED.
  740. '                                   = 5  COMM. BUFFER OVERFLOW.
  741. '                                   = 6  FUNCTION KEY PRESSED ON THE
  742. '                                        LOCAL KEYBOARD.
  743. '
  744. '  PURPOSE -- To detect incoming call and establish connection.
  745. '
  746.       SUB AnswerIt STATIC
  747.       ZErrCode = 0
  748.       ZReliableMode = ZFalse
  749.       ZFF = ZSubParm
  750.       ZSubParm = 0
  751.       ON ZFF GOTO 201,324,245,320
  752. '
  753. '
  754. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS
  755. '
  756. '
  757. 201 ZSubParm = -10
  758.     CALL Carrier
  759.     IF ZSubParm = 0 THEN _
  760.        GOTO 210
  761. '
  762. '
  763. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY
  764. '
  765. '
  766.     IF ZFossil THEN _
  767.        State = 0 : _
  768.        CALL FosDTR(ZComPort,State) _
  769.     ELSE OUT ZModemCntlReg,&H4
  770.     CALL DelayTime (ZModemInitWaitTime)
  771. '
  772. '
  773. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT
  774. '
  775. '
  776.     IF ZFossil THEN _
  777.        State = 1 : _
  778.        CALL FosDTR(ZComPort,State) _
  779.     ELSE OUT ZModemCntlReg,&H0
  780.     CALL DelayTime (ZModemInitWaitTime)
  781. 210 IF ZPrivateDoor THEN _
  782.        CALL Transfer : _
  783.        GOTO 235
  784.     CALL OpenCom(ZModemInitBaud$,",N,8,1")
  785. 220 CALL AMorPM
  786. 230 CALL Printit (" RBBS-PC " + ZVersionID$ + " Node " + _
  787.                     ZNodeID$ + " up " + ZTime$ + " on " + DATE$)
  788. 235 ZEightBit = ZTrue
  789.     IF ZExitToDoors THEN _
  790.        CALL ReadProf
  791.     ZSubParm = -10
  792.     CALL Carrier
  793.     IF ZSubParm = 0 AND _
  794.        ZExitToDoors THEN _
  795.        ZSubParm = 1 : _
  796.        GOTO 335
  797.     IF ZSubParm = 0 AND _
  798.        ZExpectActiveModem THEN _
  799.        ZBaudTest! = VAL(ZNetBaud$) : _
  800.        CALL TestRel (ZNetReliable$) : _
  801.        GOTO 328
  802.     IF ZExpectActiveModem OR _
  803.        ZExitToDoors THEN _
  804.        ZSubParm = 4 : _
  805.        ZExitToDoors = ZFalse : _
  806.        EXIT SUB
  807.     IF ZSubParm = 0 THEN _
  808.        ConnectDelay! = TIMER + ZMaxCarrierWait : _
  809.        GOTO 324
  810.     PCJr = ZFalse
  811.     IF ZComputerType = 2 AND _
  812.        ZComPort$ = "COM1" AND _
  813.        ZModemStatusReg = 1022 THEN _
  814.        ZModemGoOffHookCmd$ = CHR$(14) + _
  815.                                    "P" : _
  816.        PCJr = ZTrue
  817.     CALL SysMenu
  818.     IF PCJr THEN _
  819.        ZOutTxt$ = CHR$(14) + _
  820.             "I" _
  821.     ELSE ZOutTxt$ = ZModemResetCmd$
  822.     CALL ModemPut (ZOutTxt$)
  823.     CALL DelayTime (ZModemInitWaitTime)
  824.     IF PCJr THEN _
  825.        ZOutTxt$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  826.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  827.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  828.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  829.     ELSE ZOutTxt$ = ZModemInitCmd$
  830.     CALL ModemPut (ZOutTxt$)
  831.     IF PCJr THEN _
  832.        ZOutTxt$ = CHR$(14) + _
  833.             "F 4" : _
  834.        CALL ModemPut (ZOutTxt$)
  835.     RingBack = ZFalse
  836.     LOCATE 16,55
  837.     IF ZRequiredRings = 0 THEN _
  838.        CALL LPrnt("WAITING FOR CARRIER",0) : _
  839.        GOTO 237
  840.     IF MID$(ZModemInitCmd$, _
  841.           INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _
  842.        CALL LPrnt("RING BACK SYSTEM",0) : _
  843.        RingBack = ZTrue : _
  844.        GOTO 236
  845.     CALL LPrnt(" WAITING FOR RING ",0)
  846. 236 LOCATE 16,76 : _
  847.     CALL LPrnt(MID$(STR$(ZRequiredRings),2),0)
  848. 237 LOCATE 18,76
  849.     IF ZDosANSI THEN _
  850.        CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
  851.     ELSE CALL LPrnt ("YES",0)
  852.     COLOR ZFG,ZBG,ZBorder
  853.     LOCATE 20,56
  854. '
  855. '
  856. ' *  GET READY TO ANSWER INCOMMING CALL:
  857. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  858. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  859. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  860. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
  861. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  862. ' *           First CALLS AND THEN HANGS UP (I.E. RING-BACK).
  863. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  864. '
  865. '
  866.     WasQQ = 255
  867.     WasI = INSTR(ZModemInitCmd$,"S0")
  868.     IF WasI = 0 OR PCJr THEN _
  869.        GOTO 239
  870.     IF VAL(MID$(ZModemInitCmd$,WasI + 3,3)) = 255 THEN _
  871.        WasQQ = 0 : _
  872.        ZBlk = WasQQ
  873.     ZSecsUsedSession! = TIMER
  874.     ZSubParm = 1
  875.     CALL Line25
  876.     RingAnswer = ZTrue
  877.     IF RingBack THEN _
  878.        RingAnswer = ZFalse
  879. 239 RingBackWaitStart! = 0
  880.     IF RingBack THEN _
  881.        RingBackWaitStart! = TIMER : _
  882.        COLOR 7,0,0 _
  883.     ELSE COLOR ZFG,ZBG,ZBorder
  884. 240 IF ZSysopNext THEN _
  885.        ZSubParm = 3 : _
  886.        EXIT SUB
  887. '
  888. '
  889. ' * WAIT FOR INCOMING CALLS
  890. '
  891. '
  892.     ScreenCleared = ZFalse
  893. 245 InactiveDelay! = TIMER + (60 * ZRecycleWait)
  894.     NoCall = ZTrue
  895.     CALL FlushCom (ModemResponse$)
  896.     ModemResponse$ = ""
  897. 247 IF INP(ZModemStatusReg) > 127 OR (NOT NoCall) THEN _
  898.        GOTO 274
  899.        CALL FindFKey
  900.        IF ZSubParm < 0 THEN _
  901.           EXIT SUB
  902. 250    IF ZKeyPressed$ = ZEscape$ THEN _
  903.           ZSubParm = 3 : _
  904.           EXIT SUB
  905.        IF ZKeyPressed$ <> "" THEN _
  906.           GOTO 235
  907. 260    IF RingBackWaitStart! > 0 THEN _
  908.           CALL CheckTime(RingBackWaitStart!, TempElapsed!, 2) : _
  909.           IF TempElapsed! > 45 THEN _
  910.              RingBackWaitStart! = 0 : _
  911.              RingBackCount = 0 : _
  912.              RingAnswer = ZFalse: _
  913.              IF RingBack THEN _
  914.                LOCATE 20,56 : _
  915.                CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1)
  916. 265    CALL CheckTime(ZSecsUsedSession!, TempElapsed!, 2)
  917.        IF TempElapsed! > 120 AND NOT ScreenCleared THEN _
  918.           LOCATE ,,0 : _
  919.           CLS : _
  920.           ZWasCL = 1 : _
  921.           ScreenCleared = ZTrue : _
  922.           ZSecsUsedSession! = TIMER
  923.        IF ZTimeToDropToDos! > 0 THEN _
  924.           IF ZOldDate$ <> DATE$ THEN _
  925.           IF TIMER => ZTimeToDropToDos! AND _
  926.              TIMER < 86340 THEN _      ' Skip btw 23:59 and 00:00
  927.                 ZSubParm = 7 : _
  928.                 EXIT SUB
  929. 266    IF (INP(ZModemStatusReg) AND &H40) > 0 AND _
  930.           ZRequiredRings > 0 THEN _
  931.           GOTO 276
  932. 270    IF ZRecycleWait > 0 THEN _
  933.           CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _
  934.           IF TempElapsed! <= 0 THEN _
  935.              ZSubParm = 8 : _
  936.              EXIT SUB
  937.        CALL FlushCom (WasX$)
  938.        IF LEN(WasX$) > 0 THEN _
  939.           ModemResponse$ = ModemResponse$ + WasX$ : _
  940.           RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _
  941.           ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _
  942.           NoCall = (NOT RingDetected) AND (NOT ConnectDetected)
  943.     IF RingDetected AND ZRequiredRings > 0 THEN _
  944.        MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _
  945.        RingDetected = ZFalse : _
  946.        GOTO 276
  947.     CALL GoIdle
  948.     GOTO 247
  949. 274 IF NOT RingBack THEN _
  950.        IF ConnectDetected THEN _
  951.           GOTO 321
  952.     IF ZRequiredRings = 0 THEN _
  953.        CALL DelayTime (3) : _
  954.        GOTO 321
  955. '
  956. '
  957. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR
  958. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --
  959. ' * "RING BACK."
  960. '
  961. '
  962. 276 CALL EofComm (Char)
  963.     IF Char <> -1 THEN _
  964.        CALL FlushCom(WasX$) : _
  965.        IF ZSubParm = - 1 THEN _
  966.           EXIT SUB
  967.     IF PCJr THEN _
  968.        GOTO 320
  969.     ZOutTxt$ = ZModemCountRingsCmd$
  970.     CALL ModemPut (ZOutTxt$)
  971.     CALL DelayTime (ZModemCmdDelayTime)
  972. 290 CALL FlushCom(WasX$)
  973.     IF ZSubParm = -1 THEN _
  974.        EXIT SUB
  975. 291 IF LEN(WasX$) = 0 THEN _
  976.        GOTO 310
  977. 292 IF INSTR(WasX$,"0") < 1 THEN _
  978.        GOTO 293
  979.     WasX$ = MID$(WasX$,INSTR(WasX$,"0"),4)
  980. 293 IF (NOT RingAnswer) AND (VAL(WasX$) < RingBackCount) THEN _
  981.        RingAnswer = ZTrue
  982. 300 RingBackCount = VAL(WasX$)
  983.     ZWasQ = RingBackCount + 1
  984.     IF (NOT RingAnswer) THEN _
  985.        ZWasQ = 0
  986. 305 LOCATE 20,56
  987.     CALL LPrnt(TIME$ + " Ring " + STR$(ZWasQ),0)
  988. 310 IF (RingBackCount + 1 < ZRequiredRings) OR _
  989.        (NOT RingAnswer) THEN _
  990.        GOTO 239
  991. 320 IF PCJr THEN _
  992.        ZOutTxt$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  993.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  994.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  995.     ELSE ZOutTxt$ = ZModemAnswerCmd$
  996.     CALL ModemPut (ZOutTxt$)
  997. '
  998. '
  999. ' *  TEST FOR Carrier PRESENT
  1000. '
  1001. '
  1002. 321 ConnectDelay! = TIMER + ZMaxCarrierWait
  1003. 322 CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1004. 323 ZSubParm = -10
  1005.     CALL Carrier
  1006.     IF ZSubParm AND _
  1007.        TempElapsed! > 0 THEN _
  1008.        GOTO 322
  1009.     IF ZSubParm THEN _
  1010.        ZSubParm = 4 : _
  1011.        EXIT SUB
  1012.     CALL DelayTime (3)
  1013. 324 ZSubParm = 0
  1014.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1015.     IF TempElapsed! <= 0 THEN _
  1016.        CALL UpdtCalr ("Connect timeout",1) : _
  1017.        ZSubParm = 4 : _
  1018.        EXIT SUB
  1019. 325 CALL FlushCom(WasX$)
  1020.     IF ZSubParm = -1 THEN _
  1021.        IF ZErrCode = 69 THEN _
  1022.           ZSubParm = 5 : _
  1023.        EXIT SUB
  1024.     ModemResponse$ = ModemResponse$ + WasX$
  1025.     IF LEN(ModemResponse$) > 200 THEN _
  1026.        ModemResponse$ = RIGHT$(ModemResponse$,20)
  1027.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1028.     IF TempElapsed! <= 0 THEN _
  1029.        CALL UpdtCalr ("Connect timeout",1) : _
  1030.        ZSubParm = 4 : _
  1031.        EXIT SUB
  1032.     IF ZDumbModem THEN _
  1033.        ZBaudTest! = VAL(ZModemInitBaud$) : _
  1034.        GOTO 327
  1035.     IF INSTR(ModemResponse$,"FAST") THEN _
  1036.        ZBaudTest! = 19200 : _
  1037.        GOTO 327
  1038.     IF INSTR(ModemResponse$,"ONNECT") THEN _
  1039.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONNECT") + 7)) : _
  1040.        GOTO 327
  1041.     IF INSTR(ModemResponse$,"ONLINE") THEN _
  1042.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONLINE") + 7)) : _
  1043.        GOTO 327
  1044.     GOTO 324
  1045. 327 CALL TestRel (ModemResponse$)
  1046. 328 IF ZBaudTest! = 0 OR ZBaudTest! = 300 THEN _
  1047.        ZBaudTest! = 300 : _
  1048.        ZBPS = -1 : _
  1049.        GOTO 331
  1050.     IF ZBaudTest! = 1200 OR ZBaudTest! = 1275 THEN _
  1051.        ZBPS = -3 : _
  1052.        GOTO 331
  1053.     IF ZBaudTest! = 2400 THEN _
  1054.        ZBPS = -4 : _
  1055.        GOTO 331
  1056.     IF ZBaudTest! = 4800 THEN _
  1057.        ZBPS = -5 : _
  1058.        GOTO 331
  1059.     IF ZBaudTest! >= 7200 AND ZBaudTest! <= 14400 THEN _
  1060.        ZBPS = -6 : _
  1061.        GOTO 331
  1062.     IF ZBaudTest! = 19200 THEN _
  1063.        ZBPS = -7 : _
  1064.        GOTO 331
  1065.     IF ZBaudTest! = 38400 THEN _
  1066.        ZBPS = -8 : _
  1067.        GOTO 331
  1068.     GOTO 324
  1069. 331 CALL SetBaud
  1070.     ZSubParm = 2
  1071. 335 DontWrite = 0
  1072.     END SUB
  1073. 336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection'
  1074. ' $PAGE
  1075. '
  1076. '  NAME    -- TestRel
  1077. '
  1078. '  INPUTS  --     PARAMETER                    MEANING
  1079. '                 Strng$                 String to check for reliable
  1080. '
  1081. '  OUTPUTS --    ZReliableMode          Reliable mode indicator
  1082. '
  1083. '  PURPOSE -- To test for reliable connect
  1084. '
  1085.     SUB TestRel (Strng$) STATIC
  1086.     ZReliableMode = ZFalse
  1087.     IF Strng$ = "" THEN _
  1088.        EXIT SUB
  1089.     IF INSTR(Strng$,"REL") OR _
  1090.        INSTR(Strng$,"R C") OR _
  1091.        INSTR(Strng$,"ARQ") OR _
  1092.        INSTR(Strng$,"LAP") OR _
  1093.        INSTR(Strng$,"AFT") OR _
  1094.        INSTR(Strng$,"ECL") OR _
  1095.        INSTR(Strng$,"MNP") THEN _
  1096.          ZReliableMode = -1
  1097.     END SUB
  1098. 455 ' $SUBTITLE: 'BadChar - sub to check user names for bad characters'
  1099. ' $PAGE
  1100. '
  1101. '  NAME    -- BadChar
  1102. '
  1103. '  INPUTS  --     PARAMETER                    MEANING
  1104. '                 PassedName$                  USER NAME
  1105. '
  1106. '  OUTPUTS --    PassedName$            USER NAME WILL CONTAIN ""
  1107. '                                       IF BAD CHARACTERS Found
  1108. '
  1109. '  PURPOSE -- To check user names for invalid characters
  1110. '
  1111.     SUB BadChar (PassedName$) STATIC
  1112.     WasJ = 1
  1113.     WasXX = LEN(PassedName$)
  1114. 457 IF WasJ > WasXX THEN _
  1115.        EXIT SUB
  1116.     WasX$ = MID$(PassedName$,WasJ,1)
  1117.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",WasX$) = 0 THEN _
  1118.        PassedName$ = "" : _
  1119.        EXIT SUB
  1120.     WasJ = WasJ + 1
  1121.     GOTO 457
  1122.     END SUB
  1123. 660 ' $SUBTITLE: 'PassWrd - verify User and Message passwords'
  1124. ' $PAGE
  1125. '
  1126. '  NAME    -- PassWrd
  1127. '
  1128. '  INPUTS  --     PARAMETER                    MEANING
  1129. '                 ZSubParm         = 1      VERIFY USER PASSWORD
  1130. '                                  = 2      VERIFY MESSAGE PASSWORD
  1131. '                                  = 3      VERIFY MESSAGE PASSWORD
  1132. '                                  = 4      VERIFY MESSAGE PASSWORD
  1133. '                                  = 5      VERIFY MESSAGE PASSWORD
  1134. '
  1135. '  OUTPUTS -- ZPswdFailed                   SET TO 0 IF PASSED
  1136. '                                           SET TO -1 IF FAILED
  1137. '
  1138. '  PURPOSE -- To verify user and message passwords
  1139. '
  1140.     SUB PassWrd STATIC
  1141.     ZErrCode = 0
  1142.     ON ZSubParm GOTO 665,667,670,675,677
  1143. 665 IF ZPswdSave$ = ZPswd$ THEN _
  1144.        ZPswdFailed = 0 : _
  1145.        EXIT SUB
  1146. 667 Attempts = 0
  1147. 670 Attempts = Attempts + 1
  1148.     IF Attempts > ZAttemptsAllowed THEN _
  1149.        ZPswdFailed = ZTrue : _
  1150.        EXIT SUB
  1151. 675 ZOutTxt$ = "Enter Password"
  1152.     ZHidden = ZTrue
  1153.     CALL PopCmdStack
  1154.     IF ZSubParm < 0 THEN _
  1155.        ZPswdFailed = ZTrue : _
  1156.        EXIT SUB
  1157.     ZHidden = ZFalse
  1158.     ZWasZ$ = ZUserIn$
  1159. 677 IF LEN(ZWasZ$) > 15 THEN _
  1160.        GOTO 680
  1161.     IF ZErrCode <> 0 THEN _
  1162.        GOTO 670
  1163.     CALL AllCaps (ZWasZ$)
  1164.     ZWasZ$ = ZWasZ$ + SPACE$(15 - LEN(ZWasZ$))
  1165.     IF ZPswdSave$ = ZWasZ$ THEN _
  1166.        ZPswdFailed = 0 : _
  1167.        ZOutTxt$ = "" : _
  1168.        EXIT SUB
  1169. 680 CALL QuickTPut1 ("Wrong password ")
  1170.     ZLastIndex = 0
  1171.     IF NOT ZMsgPswd THEN _
  1172.        CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1)
  1173.     GOTO 670
  1174.     END SUB
  1175. 945 ' $SUBTITLE: 'Line25 - sub to build/display RBBS-PCs line 25'
  1176. ' $PAGE
  1177. '
  1178. '  NAME    -- Line25
  1179. '
  1180. '  INPUTS  --     PARAMETER                    MEANING
  1181. '                 ZSubParm           = 1  BUILD DISPLAY FOR LINE 25
  1182. '                                    = 2  UPDATE LINE 25
  1183. '                 ZLockStatus$            STATUS OF LOCKS IN A MULTI-
  1184. '                                         USER ENVIRONMENT OR TIME OF
  1185. '                                         DAY USER LOGGED ON OR THE
  1186. '                                         RE-CYCLED
  1187. '
  1188. '  OUTPUTS -- ZCursorLine                 CURRENT LINE ON SCREEN
  1189. '             ZCursorRow                  CURRENT ROW ON ZCursorLine
  1190.  
  1191. '
  1192. '  PURPOSE -- To build or update RBBS-PC's line 25 displayed
  1193. '             on the PC screen that is running RBBS-PC.
  1194. '
  1195.       SUB Line25 STATIC
  1196.       IF ZSubParm = 2 THEN _
  1197.          GOTO 950
  1198. '
  1199. '
  1200. ' *  BUILD LINE 25 DISPLAY
  1201. '
  1202. '
  1203. 949 ZLine25$ = "Node " + _
  1204.                ZNodeID$ + " " + _
  1205.                ZPageStatus$ + " " + _
  1206.                MID$("AVL ",1, -4 * ZSysopAvail) + _
  1207.                MID$("ANY ",1, -4 * ZSysopAnnoy) + _
  1208.                MID$("LPT ",1, -4 * ZPrinter) + _
  1209.                MID$("SYS ",1, -4 * ZSysopNext) + _
  1210.                MID$("XOFF ",1,-5 * ZXOffEd) + _
  1211.                MID$("CTS ",1,-4 * ZNotCTS)
  1212. '
  1213. '
  1214. ' *  LINE 25 UPDATE ROUTINE
  1215. '
  1216. '
  1217. 950 IF NOT ZSnoop THEN _
  1218.        EXIT SUB
  1219.     ZCursorLine = CSRLIN
  1220.     ZCursorRow = POS(0)
  1221.     ZWasHH = LEN(ZActiveUserName$) + _
  1222.          LEN(ZWasCI$) + _
  1223.          LEN(ZLine25$) + _
  1224.          LEN(STR$(ZUserSecLevel))
  1225.     LOCATE 25,1
  1226.     IF ZNetworkType = 0 THEN _
  1227.        IF ZAutoDownYes THEN _
  1228.           ZLockStatus$ = " AD " + _
  1229.                          ZTimeLoggedOn$ _
  1230.        ELSE ZLockStatus$ = SPACE$(4) + _
  1231.                            ZTimeLoggedOn$
  1232.     IF ZWasHH > 63 THEN _
  1233.        ZWasHH = 0 _
  1234.     ELSE _
  1235.        ZWasHH = 64 - ZWasHH
  1236.     ZLine25Hold$ = ZLine25$ + _
  1237.                     SPACE$(ZWasHH) + _
  1238.                     STR$(ZUserSecLevel) + _
  1239.                     " " + _
  1240.                     ZActiveUserName$ + _
  1241.                     " " + _
  1242.                     ZWasCI$
  1243.     ZLine25Hold$ = LEFT$(ZLine25Hold$, 66) + " " + ZLockStatus$
  1244.     IF ZDosANSI THEN _
  1245.        ZLine25Hold$ = ZColorReset$ + ZLine25Hold$ + ZEmphasizeOff$
  1246.     CALL LPrnt(ZLine25Hold$,0)
  1247.     LOCATE ZCursorLine,ZCursorRow
  1248.     END SUB
  1249. 1238 ' $SUBTITLE: 'SearchCmd    - sub to search command list'
  1250. ' $PAGE
  1251. '
  1252. '  NAME    -- SearchCmd
  1253. '
  1254. '  INPUTS  -- PARAMETER             MEANING
  1255. '             StartPos         POSITION TO BEGIN SEARCH AT
  1256. '             ZAllOpts$        STRING TO SEARCH (COMMAND LIST)
  1257. '             ZWasZ$            WHAT TO LOOK FOR
  1258. '
  1259. '  OUTPUTS -- WhereFound   POSITION OF ZWasZ$ IN ZAllOpts$
  1260. '                           0 IF NOT Found
  1261. '
  1262. '  PURPOSE -- Searches valid command list for the requested
  1263. '             command.  If the sysop has configured RBBS-PC to
  1264. '             restrict commands to only those valid within the
  1265. '             RBBS-PC subsystem, then only those commands and
  1266. '             "GLOBAL" commands are valid.  Otherwise all commands
  1267. '             are valid from any of the RBBS-PC subsections.
  1268. '
  1269.      SUB SearchCmd (StartPos,WhereFound) STATIC
  1270. 1240 IF LEN(ZWasZ$) < 1 THEN _
  1271.         WhereFound = 0 : _
  1272.         EXIT SUB
  1273.      CALL Trim (ZWasZ$)
  1274.      CALL AllCaps (ZWasZ$)
  1275.      ZWasY$ = LEFT$(ZWasZ$,1)
  1276.      WhereFound = INSTR(StartPos,ZAllOpts$,ZWasY$)
  1277.      IF WhereFound = 0 THEN _  'Not found: decide whether to hunt further
  1278.         IF StartPos < 2 OR ZRestrictValidCmds THEN _
  1279.            GOTO 1242 _  ' fully searched or restricted
  1280.         ELSE WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _ 'hunt further
  1281.              GOTO 1242
  1282.      IF WhereFound => ZBegLibrary THEN _
  1283.         IF WhereFound < LEN(ZAllOpts$) - 11 THEN _
  1284.            IF ZLibType = 0 THEN _
  1285.               WhereFound = INSTR(WhereFound+1,AllOpt$,ZWasY$) : _
  1286.               IF WhereFound = 0 THEN _
  1287.                  WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _
  1288.                  IF WhereFound >= ZBegLibrary OR WhereFound = 0 THEN _
  1289.                     WhereFound = 0 : _
  1290.                     GOTO 1242
  1291.      IF NOT ZRestrictValidCmds THEN _
  1292.         GOTO 1242            ' everything found valid
  1293. '
  1294. '
  1295. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)
  1296. '
  1297. '
  1298.      IF WhereFound > LEN(ZAllOpts$) - 11 THEN _
  1299.         IF ZUserSecLevel < ZOptSec(WhereFound) THEN _
  1300.            WhereFound = 0 : _
  1301.            EXIT SUB _
  1302.         ELSE GOTO 1242
  1303.      IF MID$(ZOrigCommands$,WhereFound,1) = "G" THEN _
  1304.         GOTO 1242          ' ACCEPT GOODBYE/GRAPHICS
  1305.      IF (WhereFound < StartPos) OR _
  1306.         (StartPos < ZBegFile AND WhereFound => ZBegFile ) OR _
  1307.         (StartPos < ZBegUtil AND WhereFound => ZBegUtil ) OR _
  1308.         (StartPos < ZBegLibrary AND WhereFound => ZBegLibrary ) THEN _
  1309.            WhereFound = 0                 ' REJECT: NOT IN Section
  1310. 1242 IF WhereFound > 0 THEN _
  1311.         LSET ZLastCommand$ = ZActiveMenu$ + MID$(ZOrigCommands$,WhereFound) : _
  1312.         EXIT SUB
  1313.      IF ZMacroActive OR LEN(ZWasZ$) <> 1 THEN _
  1314.         EXIT SUB
  1315.      CALL Macro (ZWasZ$,Found)
  1316.      IF Found THEN _
  1317.         CALL FDMACEXE : _
  1318.         ZWasZ$ = ZUserIn$(1) : _
  1319.         GOTO 1240
  1320.      END SUB
  1321. 1320 ' $SUBTITLE: 'CheckMacro - sub to check if macro exists & process'
  1322. ' $PAGE
  1323. '
  1324. '  NAME    -- CheckMacro
  1325. '
  1326. '  INPUTS  -- PARAMETER             MEANING
  1327. '             Strng$               STRING TO CHECK IF IS A MACRO
  1328. '             ZMacroDrvPath$       DRIVE/PATH WHERE MACROS ARE
  1329. '             ZMacroExtension$     EXTENSION WasOF MACROS
  1330. '             MACRO.OFF            FORCE NO MACRO TO BE Found
  1331. '
  1332. '  OUTPUTS -- MacroFound           WHETHER A MACRO WAS Found
  1333. '             Strng$               SUBSTITUTE FOR COMMANDS
  1334. '             ZCommPortStack$      REST OF MACRO
  1335. '                                  0 IF NOT Found
  1336. '
  1337. '  PURPOSE -- Macro file is checked for security (1st line).
  1338. '             2nd line is substituted for passed string
  1339. '             and parsed.  Remaining part of macro put into
  1340. '             stack to be executed.
  1341. '
  1342.      SUB CheckMacro (Strng$,MacroFound) STATIC
  1343.      MacroFound = ZFalse
  1344.      IF ZMacroExtension$ = "" OR INSTR(Strng$,".") > 0 THEN _
  1345.         EXIT SUB
  1346.      IF LEN(Strng$) < ZMacroMin THEN _
  1347.         ZMacroMin = 1 : _
  1348.         EXIT SUB
  1349.      IF LEN(Strng$) = 1 THEN _
  1350.         Temp$ = Strng$ : _
  1351.         CALL AllCaps (Temp$) : _
  1352.         IF INSTR(ZAllOpts$,Temp$) > 0 THEN _
  1353.            EXIT SUB
  1354.      CALL Macro (Strng$,MacroFound)
  1355.      END SUB
  1356. 1325 ' $SUBTITLE: 'Macro - check if macro exists & process'
  1357. ' $PAGE
  1358. '
  1359. '  NAME    -- Macro
  1360. '
  1361. '  INPUTS  -- PARAMETER             MEANING
  1362. '             Strng$           STRING TO CHECK IF IS A MACRO
  1363. '             ZMacroDrvPath$   DRIVE/PATH WHERE MACROS ARE
  1364. '             ZMacroExtension$ EXTENSION OF MACROS
  1365. '             MACRO.OFF        FORCE NO MACRO TO BE Found
  1366. '
  1367. '  OUTPUTS -- MacroFound       WHETHER A MACRO WAS Found
  1368. '             Strng$           SUBSTITUTE FOR COMMANDS
  1369. '             ZCommPortStack$  REST OF MACRO
  1370. '                              0 IF NOT Found
  1371. '
  1372. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  1373. '             letter uses a command.
  1374.      SUB Macro (Strng$,MacroFound) STATIC
  1375.      MacroFound = ZFalse
  1376.      FilName$ = Strng$
  1377.      CALL BreakFileName (FilName$,ZWasDF$,Prefix$,WasX$,ZFalse)
  1378.      IF WasX$ = "" THEN _
  1379.         FilName$ = Strng$ + ZMacroExtension$
  1380.      IF ZWasDF$ = "" THEN _
  1381.         FilName$ = ZMacroDrvPath$ + FilName$
  1382.      CALL BadFile (FilName$,ZWasA)
  1383.      IF ZWasA > 1 THEN _
  1384.         EXIT SUB
  1385.      CALL GRAPHICX (ZUserGraphicDefault$,FilName$,6)
  1386.      IF NOT ZOK THEN _
  1387.         EXIT SUB
  1388.      CALL ReadDir (6,1)
  1389.      IF ZErrCode > 0 THEN _
  1390.         EXIT SUB
  1391.      CALL CheckInt (ZOutTxt$)
  1392.      IF ZErrCode > 0 OR ZUserSecLevel < ZTestedIntValue THEN _
  1393.         EXIT SUB
  1394.      ZWasA = INSTR(ZOutTxt$,"/")
  1395.      IF ZWasA > 0 THEN _    ' Check macro contraint
  1396.         WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-ZWasA) : _
  1397.         IF RIGHT$(WasX$,1) = "/" THEN _
  1398.            IF ZLastCommand$ <> LEFT$(WasX$,LEN(WasX$)-1) THEN _
  1399.               EXIT SUB _
  1400.            ELSE GOTO 1327 _
  1401.         ELSE IF LEFT$(ZLastCommand$,LEN(WasX$)) <> WasX$ THEN _
  1402.                 EXIT SUB
  1403. 1327 ZMacroActive = ZTrue
  1404.      MacroFound = ZTrue
  1405.      ZMacroEcho = ZTrue
  1406.      END SUB
  1407. 1330 ' $SUBTITLE: 'ViewHelp    - Processes requests for help'
  1408. ' $PAGE
  1409. '
  1410. '  NAME    -- ViewHelp
  1411. '
  1412. '  INPUTS  -- PARAMETER             MEANING
  1413. '            Section             ORDER OF 1ST COMMAND IN CURRENT
  1414. '                                Section
  1415. '            GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1416. '            HelpDefault$        HELP GET IF PRESS ENTER
  1417. '            ZHelpPath$
  1418. '            ZHelpExtension$
  1419. '            ZBegFile
  1420. '            ZBegMain
  1421. '            ZBegUtil
  1422. '            ZBegLibrary
  1423. '
  1424. '  OUTPUTS -- DISPLAYS HELP
  1425. '
  1426. '  PURPOSE -- The main help processor for RBBS.  Puts up the
  1427. '             optional menu.  Accepts help with individual commands.
  1428. '
  1429.      SUB ViewHelp (Section,GraphicDefault$,HelpDefault$) STATIC
  1430.      HelpMenu$ = ZHelpPath$ + _
  1431.                   "HELP" + _
  1432.                   ZHelpExtension$
  1433.      SotMenu = ZTrue
  1434.      IF ZWasQ > 1 THEN _
  1435.         ZAnsIndex = 2 : _
  1436.         ZLastIndex = ZWasQ: _
  1437.         FastHelp = ZTrue : _
  1438.         GOTO 1332
  1439. 1331 IF SotMenu THEN _
  1440.         ZFileName$ = HelpMenu$ : _
  1441.         GOSUB 1350 : _
  1442.         SotMenu = ZFalse
  1443.      ZAnsIndex = 1
  1444.      ZOutTxt$ = "Help with what Command (or Topic name)" + _
  1445.           ZPressEnterExpert$
  1446.      ZSubParm = 1
  1447.      CALL TGet
  1448.      IF ZSubParm = -1 THEN _
  1449.         EXIT SUB
  1450.      IF ZWasQ = 0 THEN _
  1451.         EXIT SUB
  1452.      ZLastIndex = ZWasQ
  1453. 1332 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1454.      CALL AllCaps (ZWasZ$)
  1455.      IF ZWasZ$ = "?" THEN _
  1456.         ZWasZ$ = "H"
  1457.      CALL BadFile (ZWasZ$,BadFileNameIndex)
  1458.      ON BadFileNameIndex GOTO 1333,1340,1340
  1459. 1333 IF LEN(ZWasZ$) <> 1 THEN _
  1460.         GOTO 1335
  1461.      CALL SearchCmd (Section,ZFF)
  1462.      IF ZFF < 1 THEN _
  1463.         ZOK = ZFalse : _
  1464.         GOTO 1336
  1465.      IF ZFF > LEN(ZAllOpts$) - 11 THEN _
  1466.         IF ZFF > LEN(ZAllOpts$) - 7 AND NOT ZSysop THEN _
  1467.            ZOK = ZFalse : _
  1468.            GOTO 1336 _
  1469.         ELSE ZWasZ$ = MID$(ZOrigCommands$,ZFF,1) : _
  1470.              GOTO 1335 _
  1471.      ELSE WasX = - (ZFF => ZBegMain) - (ZFF => ZBegFile) - (ZFF => ZBegUtil) - (ZFF => ZBegLibrary) : _
  1472.           ZWasZ$ = MID$("MFU@",WasX,1) + _
  1473.                    MID$(ZOrigCommands$,ZFF,1)
  1474. 1335 ZFileName$ = ZHelpPath$ + _
  1475.                   ZWasZ$ + _
  1476.                   ZHelpExtension$
  1477.      GOSUB 1350
  1478. 1336 IF NOT ZOK THEN _
  1479.         ZOutTxt$ = "No help for " + _
  1480.              ZWasZ$ : _
  1481.         CALL QuickTPut1 (ZOutTxt$) : _
  1482.         CALL UpdtCalr (ZOutTxt$,2)
  1483.      ZAnsIndex = ZAnsIndex + 1
  1484.      IF ZAnsIndex <= ZLastIndex THEN _
  1485.         GOTO 1332
  1486.      IF FastHelp THEN _
  1487.         FastHelp = ZFalse : _
  1488.         EXIT SUB
  1489.      GOTO 1331
  1490. 1340 ZOK = ZFalse
  1491.      GOTO 1336
  1492. 1350 CALL Graphic (GraphicDefault$,ZFileName$)
  1493.      CALL BufFile (ZFileName$,WasX)
  1494.      RETURN
  1495.      END SUB
  1496. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1497. ' $PAGE
  1498. '
  1499. '  NAME    -- SecViolation
  1500. '
  1501. '  INPUTS  --     PARAMETER                    MEANING
  1502. '
  1503. '  OUTPUTS -- ZCursorLine               CURRENT LINE ON SCREEN
  1504. '             ZCursorRow                CURRENT ROW ON ZCursorLine
  1505. '
  1506. '  PURPOSE -- Inform caller of security violation, augment count of
  1507. '             violations and determine whether too many occurred.
  1508. '
  1509.      SUB SecViolation STATIC
  1510.      CALL FlushKeys
  1511.      CALL BufFile (ZSecVioHelp$,WasX)
  1512.      IF NOT ZOK THEN _
  1513.         CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", action not permitted")
  1514.      CALL UpdtCalr ("SV!-" + ZViolation$,2)
  1515.      ZLastIndex = 0
  1516.      CALL Muzak (3)
  1517.      ZViolationsThisSession = ZViolationsThisSession + 1
  1518.      IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
  1519.         EXIT SUB
  1520. 1385 IF ZUserFileIndex < 1 THEN _
  1521.         EXIT SUB
  1522.      ZOutTxt$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1523.      IF ZUserSecLevel <= ZMinLogonSec THEN _
  1524.         ZOutTxt$ = "" : _
  1525.         ZUserSecLevel = ZUserSecLevel - 1 _
  1526.      ELSE ZUserSecLevel = ZMinLogonSec
  1527.      ZDenyAccess = ZTrue
  1528.      END SUB
  1529. 1386 ' $SUBTITLE: 'DenyAccess - sub to permanently deny access'
  1530. ' $PAGE
  1531. '
  1532. '  NAME    -- DenyAccess
  1533. '
  1534. '  INPUTS  --     PARAMETER                    MEANING
  1535. '
  1536. '  OUTPUTS -- (USER'S RECORD)
  1537. '
  1538. '  PURPOSE -- Permanently resets user's security level when access denied
  1539. '
  1540.      SUB DenyAccess STATIC
  1541.      CALL TPut
  1542.      ZLogonErrorIndex = 5
  1543.      ZSubParm = 6
  1544.      CALL FileLock
  1545.      CALL OpenUser (HighestUserRecord)
  1546.      FIELD 5, 128 AS ZUserRecord$
  1547.      GET 5,ZUserFileIndex
  1548.      MID$(ZUserRecord$,47,2) = MKI$(ZUserSecLevel)
  1549.      PUT 5,ZUserFileIndex
  1550.      ZSubParm = 8
  1551.      CALL FileLock
  1552.      END SUB
  1553. 1396 ' $SUBTITLE: 'TPut -- common routine to write to comm. port'
  1554. ' $PAGE
  1555. '
  1556. '  NAME    -- TPut (TERMINAL PUT)
  1557. '
  1558. '  INPUTS  --     PARAMETER                    MEANING
  1559. '                     ZOutTxt$                 STRING TO WRITE TO THE
  1560. '                                              COMMUNICATIONS PORT
  1561. '                 ZSubParm = 1           SKIP A LINE BEFORE WRITING
  1562. '                                        TO THE COMMUNICATIONS PORT
  1563. '                          = 2           SKIP A LINE BEFORE WRITING
  1564. '                                        TO THE COMMUNICATIONS PORT
  1565. '                                        AND THEN SKIP TWO LINES
  1566. '                                        AFTER WRITING TO THE COMM-
  1567. '                                        UNICATIONS PORT
  1568. '                           = 3          WRITE TO THE COMMUNICATIONS
  1569. '                                        PORT AND THEN SKIP TWO LINES
  1570. '                           = 4          WRITE TO THE COMMUNICATIONS
  1571. '                                        PORT WITHOUT A CR/LF
  1572. '                           = 5          WRITE TO THE COMMUNICATIONS
  1573. '                                        PORT WITH A CR/LF
  1574. '                           = 6          RESET EVERYTHING FOR INPUT STRING
  1575. '                           = 7          RE-ENTRY AFTER HANDLING A
  1576. '                                        FUNCTION KEY
  1577. '
  1578. '  OUTPUTS --  ZSubParm = -1 Carrier HAS BEEN DROPPED
  1579. '              ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1580. '
  1581. '  PURPOSE --  Common output routine for RBBS-PC to the
  1582. '              communications port (terminal put)
  1583.       SUB TPut STATIC
  1584.       IF ZSubParm <> 7 THEN _
  1585.          Parm = ZSubParm
  1586.       ON ZSubParm GOTO 1398,1399,1400,1403,1405,1450,1411
  1587. '
  1588. '
  1589. ' *  COMMON OUTPUT ROUTINE
  1590. '
  1591. '
  1592. 1398 CALL SkipLine (1)
  1593.      GOTO 1405
  1594. 1399 CALL SkipLine (1)
  1595. 1400 ZCR = 1
  1596. 1403 ZCR = ZCR + 1
  1597. 1405 ZRet = ZFalse
  1598.      IF ZWasCM THEN _
  1599.         GOTO 1435
  1600. 1410 CALL FindFKey
  1601.      IF ZSubParm < 0 THEN _
  1602.         EXIT SUB
  1603. 1411 ZWasY$ = ZKeyPressed$
  1604.      ZSubParm = Parm
  1605.      IF ZLocalUser THEN _
  1606.         GOTO 1430
  1607.      CALL EofComm (Char)
  1608.      IF Char = -1 THEN _
  1609.         CALL CheckCarrier : _
  1610.         IF ZSubParm = -1 THEN _
  1611.            EXIT SUB _
  1612.         ELSE GOTO 1430
  1613.      CALL GetCom(ZWasY$)
  1614. 1425 IF ZSubParm = -1 THEN _
  1615.         EXIT SUB
  1616. 1430 IF ZWasY$ = "" THEN _
  1617.         GOTO 1435
  1618.      ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433
  1619.      GOSUB 1476
  1620.      IF ZTurboKey THEN IF NOT ZStopInterrupts THEN _
  1621.         GOTO 1471
  1622.      GOTO 1435
  1623. 1433 GOSUB 1476
  1624.      IF ZStopInterrupts THEN _
  1625.         GOTO 1435
  1626.      GOTO 1471
  1627. 1434 IF ZStopInterrupts THEN _
  1628.         GOTO 1435
  1629.      ZCommPortStack$ = ""
  1630.      IF ZFossil THEN _
  1631.         CALL FOSTXPurge(ZComPort) : _
  1632.         CALL FosRXPurge(ZComPort)
  1633.      GOTO 1471
  1634. 1435 LOCATE ,,1
  1635.      CALL LPrnt (ZOutTxt$,0)
  1636. 1437 IF ZUpperCase THEN _
  1637.         IF ZWasGR <> 2 THEN _
  1638.            CALL AllCaps (ZOutTxt$)
  1639.      CALL PutCom (ZOutTxt$)
  1640. 1450 IF ZCR <> 1 THEN _
  1641.         CALL SkipLine (1) _
  1642.      ELSE IF ZCR > 1 THEN _
  1643.              CALL SkipLine (1)
  1644. 1470 ZCR = 0
  1645.      EXIT SUB
  1646. 1471 CALL SkipLine (1)
  1647.      ZStopInterrupts = ZFalse
  1648.      ZRet = ZTrue
  1649.      ZNo = ZTrue
  1650.      ZNonStop = ZFalse
  1651.      GOTO 1470
  1652. 1473 ZXOffEd = ZTrue
  1653.      GOTO 1410
  1654. 1475 ZXOffEd = ZFalse
  1655.      GOTO 1410
  1656. 1476 IF ASC(ZWasY$) < 127 THEN _
  1657.         ZCommPortStack$ = ZCommPortStack$ + ZWasY$
  1658.      RETURN
  1659.      END SUB
  1660. 1478 ' $SUBTITLE: 'QuickTPut - subroutine to quickly write to terminal'
  1661. ' $PAGE
  1662. '
  1663. '  NAME    -- QuickTPut
  1664. '
  1665. '  INPUTS  -- PARAMETER             MEANING
  1666. '             Strng$             STRING TO WRITE OUT
  1667. '             NumReturns         NUMBER OF CARRIAGE RETURNS
  1668. '
  1669. '  OUTPUTS -- NONE
  1670. '
  1671. '  PURPOSE -- Subroutine to quickly write to the terminal.  This is
  1672. '             different from "TPut" in the things it doesn't do:
  1673. '                A.) No function key check,
  1674. '                B.) No conversion to upper case,
  1675. '                C.) No check for carrier present
  1676. '                D.) No check for imbedded carriage return in "Strng$"
  1677. '                E.) No support for XON/XOff
  1678. '
  1679.       SUB QuickTPut (Strng$,NumReturns) STATIC
  1680.       IF ZSubParm < 0 THEN _
  1681.          EXIT SUB
  1682.       IF ZUseTPut THEN _
  1683.          ZOutTxt$ = Strng$ : _
  1684.          ZSubParm = 4 : _
  1685.          CALL TPut : _
  1686.          CALL SkipLine (NumReturns) : _
  1687.          EXIT SUB
  1688.       CALL PutCom (Strng$)
  1689.       LOCATE ,,1
  1690.       CALL LPrnt (Strng$,0)
  1691.       CALL SkipLine (NumReturns)
  1692.       END SUB
  1693.       SUB QuickTPut1 (Strng$) STATIC
  1694.       CALL QuickTPut (Strng$,1)
  1695.       END SUB
  1696. 1480 ' $SUBTITLE: 'LPrnt    - subroutine to write to display'
  1697. ' $PAGE
  1698. '
  1699. '  NAME    -- LPrnt
  1700. '
  1701. '  INPUTS  -- PARAMETER             MEANING
  1702. '             Strng$        STRING TO WRITE OUT
  1703. '             NumReturns   NUMBER OF CARRIAGE RETURNS
  1704. '
  1705. '  OUTPUTS -- NONE
  1706. '
  1707. '  PURPOSE -- Subroutine to write to the display.
  1708. '
  1709.       SUB LPrnt (Strng$,NumReturns) STATIC
  1710.       IF NOT ZSnoop THEN _
  1711.          EXIT SUB
  1712.       CALL PScrn (Strng$)
  1713.       IF ZVoiceType <> 0 AND ZTalkAll THEN _
  1714.          CALL Talk (65,Strng$)
  1715.       IF ZUseBASICWrites THEN _
  1716.          FOR WasI = 1 TO NumReturns : _
  1717.             PRINT : _
  1718.          NEXT : _
  1719.       ELSE FOR WasI = 1 TO NumReturns : _
  1720.               LOCATE ,,1 : _
  1721.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1722.               LOCATE ZWasCL,ZWasCC : _
  1723.               NEXT
  1724.       END SUB
  1725. 1482 ' $SUBTITLE: 'QuickLPrnt - subroutine to quickly write to display'
  1726. ' $PAGE
  1727. '
  1728. '  NAME    -- QuickLPrnt
  1729. '
  1730. '  INPUTS  -- PARAMETER             MEANING
  1731. '             Strng$        STRING TO WRITE OUT
  1732. '             Num           NUMBER OF CARRIAGE RETURNS
  1733. '
  1734. '  OUTPUTS -- NONE
  1735. '
  1736. '  PURPOSE -- Subroutine to quickly write to the display.
  1737. '             Overwrites, and puts up count
  1738.       SUB QuickLPrnt (Strng$,Num) STATIC
  1739.       IF ZSnoop THEN _
  1740.          LOCATE ,1,1 : _
  1741.          CALL Pscrn (Strng$ + STR$(Num))
  1742.       END SUB
  1743. 1483 ' $SUBTITLE: 'PScrn    - subroutine to print to the screen'
  1744. ' $PAGE
  1745. '
  1746. '  NAME    -- PScrn
  1747. '
  1748. '  INPUTS  -- PARAMETER             MEANING
  1749. '             Strng$        STRING TO WRITE OUT
  1750. '
  1751. '  OUTPUTS -- NONE
  1752. '
  1753. '  PURPOSE -- Writes to local screen regardless of whether you have
  1754. '             carrier.  Assumes have positioned cursor where you want.
  1755. '
  1756.       SUB PScrn (Strng$) STATIC
  1757.       IF Strng$ = "" THEN _
  1758.          EXIT SUB
  1759.       IF ZUseBASICWrites THEN _
  1760.          PRINT Strng$; _
  1761.       ELSE CALL ANSI (Strng$,ZWasCL,ZWasCC) : _
  1762.            LOCATE ZWasCL,ZWasCC
  1763.       END SUB
  1764. 1485 ' $SUBTITLE: 'SkipLine - sub to write a blank line to user'
  1765. ' $PAGE
  1766. '
  1767. '  NAME    -- SkipLine
  1768. '
  1769. '  INPUTS  --   PARAMETER             MEANING
  1770. '               ZLocalUser
  1771. '               ZModemStatusReg
  1772. '               NumReturns
  1773. '               ZReturnLineFeed$
  1774. '               ZSnoop
  1775. '
  1776. '  OUTPUTS -- NONE
  1777. '
  1778. '  PURPOSE -- Skip lines on the user's terminal
  1779. '
  1780.       SUB SkipLine (NumReturns) STATIC
  1781.       FOR WasI=1 TO NumReturns
  1782.           CALL PutCom (ZReturnLineFeed$)
  1783.       NEXT
  1784.       IF NOT ZSnoop THEN _
  1785.          GOTO 1486
  1786.       IF ZUseBASICWrites THEN _
  1787.          FOR WasI = 1 TO NumReturns : _
  1788.             PRINT : _
  1789.          NEXT _
  1790.       ELSE FOR WasI = 1 TO NumReturns : _
  1791.               LOCATE ,,1 : _
  1792.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1793.               LOCATE ZWasCL,ZWasCC : _
  1794.            NEXT
  1795. 1486  ZLinesPrinted = ZLinesPrinted + NumReturns
  1796.       ZUnitCount = ZUnitCount - ZDisplayAsUnit * NumReturns
  1797.       END SUB
  1798. 1496 ' $SUBTITLE: 'SetCrLf -- sub to set up nulls/lf's for output'
  1799. ' $PAGE
  1800. '
  1801. '  NAME    -- SetCrLf
  1802. '
  1803. '  INPUTS  --   PARAMETER          MEANING
  1804. '              ZCarriageReturn$    CARRIAGE RETURN CHARACTER
  1805. '              ZLineFeed$          LINE FEED CHARACTER
  1806. '              ZLineFeeds          LINE FEED Switch
  1807. '              ZNul$                NULL CHARACTER
  1808. '
  1809. '  OUTPUTS -- ZReturnLineFeed$   END-OF-LINE STRING
  1810. '
  1811. '  PURPOSE -- Set up the necessary nulls/line feeds to end
  1812. '             each output to the communications port with.
  1813. '
  1814.       SUB SetCrLf STATIC
  1815.       ZReturnLineFeed$ = _
  1816.          MID$(ZCarriageReturn$,1, - (NOT ZLocalUser)) + _
  1817.          ZNul$ + _
  1818.          MID$(ZLineFeed$,1, - (ZLineFeeds <> 0))
  1819.       END SUB
  1820. 1498 ' $SUBTITLE: 'TGet -- ask a user a question and get reply'
  1821. ' $PAGE
  1822. '
  1823. '  NAME    -- TGet
  1824. '
  1825. '  INPUTS  --    PARAMETER                   MEANING
  1826. '                ZSubParm          = 1  STANDARD ENTRY
  1827. '                                  = 2  ENTRY AFTER A FUNCTION KEY
  1828. '                                         HAS BEEN HANDLED
  1829. '                                  = 3  ENTRY AFTER STACKED COMMAND
  1830. '             ZOutTxt$                        STRING TO WRITE TO THE
  1831. '                                       COMMUNICATIONS PORT
  1832. '             ZHidden                    IF THIS IS TRUE THEN ECHO
  1833. '                                       '.' INSTEAD OF ACTUAL
  1834. '                                       CHARACTER ENTERED.
  1835. '             ZForceKeyboard            IF TRUE, STACKED INPUT
  1836. '                                       IS BYPASSED AND KEYBOARD
  1837. '                                       INPUT IS READ.
  1838. '
  1839. '  OUTPUTS -- ZSubParm = -1 Carrier HAS BEEN DROPPED
  1840. '             ZUserIn$                  STRING THAT WAS ENTERED
  1841. '             ZWasQ                     NUMBER OF PARAMETERES THAT
  1842. '                                       WERE ENTERED WHICH WHERE
  1843. '                                       SEPARATED BY A SEMICOLON
  1844. '             ZUserIn$()                STRING MATRIX WITH EACH
  1845. '                                       ITEM CONTAIN THE STRING
  1846. '                                       THAT WAS ENTERED BETWEEN
  1847. '                                       SEMICOLONS.
  1848. '             ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1849. '             ZYes                      Reply IS "Y" OR "YES"
  1850. '             ZNo                       Reply IS "N" OR "NO"
  1851. '             ZNonStop                  Reply IS "NS" OR "ns"
  1852. '             ZKillMessage              Reply IS "K"
  1853. '             ZReply                    Reply IS "RE"
  1854. '
  1855. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1856. '
  1857.      SUB TGet STATIC
  1858.      MacroIndex = ZForceKeyboard
  1859.      ON ZSubParm GOTO 1500,1538,1625
  1860. '
  1861. '
  1862. ' *  COMMON INPUT ROUTINE
  1863. '
  1864. '
  1865. 1500 CALL Carrier
  1866.      IF ZSubParm = -1 THEN _
  1867.         EXIT SUB
  1868.      ZLinesPrinted = 0
  1869.      ZDisplayAsUnit = ZFalse
  1870.      InStack = ZFalse
  1871.      GOSUB 1580
  1872.      ZWasA = 0
  1873.      ZWasB = 0
  1874.      ZWasC = 0
  1875.      ZWasQ = 1
  1876.      ZStoreParseAt = 1
  1877.      ZYes = ZFalse
  1878.      ZUserIn$ = ""
  1879.      SleepWarn = ZTrue
  1880.      ZNo = ZFalse
  1881.      ZNonStop = (ZPageLength < 1)
  1882.      IF ZOutTxt$ = "" THEN _
  1883.         GOTO 1525
  1884.      IF ZHidden THEN _
  1885.         ZOutTxt$ = ZOutTxt$ + " (dots echo)"
  1886.      IF (NOT ZVerifying) OR HoldA$ = "" THEN _
  1887.         CALL ColorPrompt (ZOutTxt$) : _
  1888.         ZOutTxt$ = ZOutTxt$ + _
  1889.              MID$("? !  ",2*ZTurboKey+1,2) : _
  1890.         HoldA$ = ZOutTxt$ _
  1891.      ELSE ZOutTxt$ = HoldA$
  1892.      ZSubParm = 4
  1893.      StopSave = ZStopInterrupts
  1894.      ZStopInterrupts = ZTrue
  1895.      CALL TPut
  1896.      ZStopInterrupts = StopSave
  1897.      IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1898.         EXIT SUB
  1899. 1523 IF ZPromptBell THEN _
  1900.         IF ZLocalUser THEN _
  1901.            BEEP_
  1902.         ELSE CALL PutCom(ZBellRinger$)
  1903. 1525 CALL Carrier
  1904.      IF ZSubParm = -1 THEN _
  1905.         EXIT SUB
  1906.      IF LEN(ZCommPortStack$) > 0 THEN _
  1907.         InStack = ZTrue : _
  1908.         WasX = INSTR(ZCommPortStack$,ZCarriageReturn$) : _
  1909.         IF WasX > 0 THEN _
  1910.            ZOutTxt$ = LEFT$(ZCommPortStack$,WasX-1) : _
  1911.            ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-WasX) : _
  1912.            GOTO 1534 _
  1913.         ELSE ZWasY$ = LEFT$(ZCommPortStack$,1) : _
  1914.              ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  1915.              GOTO 1541
  1916.      IF (ZForceKeyboard OR (NOT ZMacroActive) OR (ZMacroSave > 0)) THEN _
  1917.         GOTO 1536
  1918. '
  1919. ' *** MACRO PROCESSING
  1920. '
  1921. 1526 CALL ReadMacro
  1922.      IF ZMacroSave > 0 THEN _
  1923.         GOTO 1500
  1924.      IF NOT ZMacroActive THEN _
  1925.         ZWasQ = 0 : _
  1926.         ZLastIndex = 0 : _
  1927.         EXIT SUB
  1928.      IF (ZDistantTGet > 0 ) OR (ZMacroTemplate$ <> "") THEN _
  1929.         GOTO 1536
  1930. 1534 ZUserIn$ = ZOutTxt$   ' Not Macro command - pass to normal processing
  1931.      IF ZMacroEcho THEN _
  1932.         ZSubParm = 4 : _
  1933.         CALL TPut
  1934.      WasX$ = ZCarriageReturn$
  1935.      GOTO 1547
  1936. 1536 IF ZLocalUser THEN _
  1937.         GOTO 1537
  1938.      '  CALL FindFKey: _
  1939.      '  IF ZSubParm < 0 THEN _
  1940.      '     EXIT SUB _
  1941.      '  ELSE GOTO 1538
  1942.      CALL EofComm (Char)
  1943.      IF Char <> -1 THEN _
  1944.         CALL GetCom(ZWasY$) : _
  1945.         IF ZSubParm = -1 THEN _
  1946.            EXIT SUB _
  1947.         ELSE GOTO 1541
  1948. 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
  1949.      IF TempElapsed! < 30 THEN _
  1950.         IF TempElapsed! <= 0 THEN _
  1951.            CALL SkipLine (1) : _
  1952.            ZSubParm = -1 : _
  1953.            ZNo = ZTrue : _
  1954.            ZSleepDisconnect = NOT ZAutoLogoffReq : _
  1955.            IF ZAutoLogoffReq THEN _
  1956.               CALL UpdtCalr ("Auto-logoff",1): _
  1957.               EXIT SUB _
  1958.            ELSE CALL UpdtCalr ("Sleep disconnect",1) : _
  1959.                 EXIT SUB _
  1960.         ELSE IF SleepWarn THEN _
  1961.                 SleepWarn = ZFalse : _
  1962.                 Temp! = TempElapsed! : _
  1963.                 ZOutTxt$ = "Auto-Logoff in 30 seconds..." : _
  1964.                 CALL RingCaller : _
  1965.                 CALL QuickTput ("Press Enter to cancel  30",0) _
  1966.              ELSE IF Temp! - TempElapsed! > 1.0 THEN _
  1967.                      CALL QuickTPut (ZBackSpace$+ZBackSpace$,0) : _
  1968.                      CALL QuickTPut (RIGHT$(STR$(CINT(TempElapsed!)),2),0) : _
  1969.                      Temp! = TempElapsed!
  1970.      CALL FindFKey
  1971.      IF ZSubParm < 0 THEN _
  1972.         EXIT SUB
  1973. 1538 ZWasY$ = ZKeyPressed$
  1974.      IF ZWasY$ <> "" THEN _
  1975.         GOTO 1545
  1976.      SendRemote = ZTrue
  1977.      CALL GoIdle
  1978.      GOTO 1525
  1979. 1541 SendRemote = ZRemoteEcho
  1980.      IF ZTestParity THEN _
  1981.         GOTO 1542
  1982.      IF ZWasY$ = CHR$(127) THEN _
  1983.         GOTO 1635
  1984.      GOTO 1545
  1985. 1542 IF ZWasY$ = "" THEN _
  1986.         ZWasY$ = " "
  1987.      IF ASC(ZWasY$) = 141 THEN _
  1988.         OUT ZLineCntlReg,&H1A : _
  1989.         ZEightBit = ZFalse : _
  1990.         ZTestParity = ZFalse : _
  1991.         ZWasGR = ZFalse
  1992.      ZWasY$ = CHR$(ASC(ZWasY$) AND 127)
  1993. 1545 WasX$ = ZWasY$
  1994.      ZAutoLogoffReq = ZFalse
  1995.      IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
  1996.         GOTO 1635
  1997.      IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
  1998.         GOTO 1525
  1999.      IF ZWasY$ = "^" THEN _
  2000.         GOTO 1525
  2001.      IF ZWasY$ = ZCarriageReturn$ THEN _
  2002.         GOTO 1547 _
  2003.      ELSE GOSUB 1550
  2004.      IF ZTurboKey < 1 THEN _
  2005.         GOTO 1546
  2006.      IF ZWasY$ = " " THEN _
  2007.         ZWasY$ = ""
  2008.      IF ZWasY$ <> "/" THEN _
  2009.         ZUserIn$ = ZWasY$ : _
  2010.         ZWasY$ = ZCarriageReturn$ : _
  2011.         WasX$ = ZWasY$ : _
  2012.         GOTO 1547
  2013.      ZTurboKey = 0
  2014.      GOTO 1525
  2015. 1546 IF LEN(ZUserIn$) => 512 THEN _
  2016.         ZOutTxt$ = "Input too long!" : _
  2017.         ZSubParm = 5 : _
  2018.         CALL TPut : _
  2019.         ZWasY$ = ZCarriageReturn$ : _
  2020.         WasX$ = ZWasY$ : _
  2021.         GOTO 1547
  2022.      ZUserIn$ = ZUserIn$ + _
  2023.           ZWasY$
  2024.      GOTO 1525
  2025. 1547 ZTurboKey = ZFalse          ' Carriage Return Handler
  2026.      ZHidden = ZFalse
  2027.      IF ZNoAdvance THEN _
  2028.         ZNoAdvance = ZFalse : _
  2029.         GOTO 1575 _
  2030.      ELSE CALL LPrnt (ZCrLf$,0) : _
  2031.           GOSUB 1551 : _
  2032.           GOTO 1570
  2033. 1549 IF INSTR(ZUserIn$,";") > 0 THEN _
  2034.         CALL ExcludeCount (";",ZUserIn$,Temp) _
  2035.      ELSE IF INSTR(ZUserIn$," ") > 0 THEN _
  2036.         CALL ExcludeCount (" ",ZUserIn$,Temp) _
  2037.      ELSE Temp = 0
  2038.      RETURN
  2039. 1550 IF ZLogonActive THEN _
  2040.         GOSUB 1549 : _
  2041.         ZHidden = (Temp = 2 - (ZLenIndiv > 0 AND ZStartIndiv > 0))
  2042.      IF ZHidden THEN _
  2043.         IF (WasX$ <> " " AND WasX$ <> ";") THEN _
  2044.            WasX$ = "."
  2045.      CALL LPrnt(WasX$,0)
  2046. 1551 IF NOT SendRemote THEN _
  2047.         RETURN
  2048.      IF ZHidden AND (WasX$ <> " ") THEN _
  2049.         WasX$ = "."
  2050. 1553 CALL PutCom (WasX$)
  2051.      RETURN
  2052. 1570 IF SendRemote THEN _
  2053.         IF ZLineFeeds THEN _
  2054.            CALL PutCom (ZLineFeed$)
  2055. 1575 IF LEN(ZUserIn$) > 4000 THEN _
  2056.         ZOutTxt$ = "Try again, " + _
  2057.              ZFirstName$ : _
  2058.         ZSubParm = 5 : _
  2059.         CALL TPut : _
  2060.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  2061.            EXIT SUB _
  2062.         ELSE GOTO 1500
  2063.      IF ZParseOff THEN _
  2064.         ZParseOff = ZFalse : _
  2065.         GOTO 1620
  2066.      CALL ParseIt
  2067.      IF ZWasQ = 1 THEN _
  2068.         GOTO 1622
  2069.      GOTO 1625
  2070. 1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2071.      IF ZAutoLogoffReq OR ZWaitExpired THEN _
  2072.         ZWaitExpired = ZFalse : _
  2073.         IF NOT ZSuspendAutologoff THEN _
  2074.            ZAutoLogoff! = TIMER + 30
  2075.      RETURN
  2076. 1620 ZUserIn$(ZStoreParseAt) = ZUserIn$
  2077.      ZWasQ = 1
  2078. 1622 IF ZUserIn$ = "" THEN _
  2079.         ZWasQ = 0 : _
  2080.         ZHidden = ZFalse : _
  2081.         GOTO 1628
  2082. 1625 IF LEN(ZUserIn$) < 4 THEN _
  2083.         WasX$ = LEFT$(ZUserIn$,3): _
  2084.         CALL AllCaps (WasX$) : _
  2085.         ZYes = (INSTR("YES",WasX$) = 1) : _
  2086.         ZNo = (INSTR("NO",WasX$) = 1 OR WasX$ = "A" OR WasX$ = "Q") : _
  2087.         ZReply = (WasX$ = "RE") OR ZReply : _
  2088.         ZKillMessage = (WasX$ = "K") OR ZKillMessage
  2089.      ZHidden = ZFalse
  2090. 1628 CALL VerifyAns
  2091.      IF NOT ZOK THEN _
  2092.         CALL QuickTPut1 ("Invalid answer <" + ZUserIn$(1) + ">") : _
  2093.         GOTO 1500
  2094.      HoldA$ = ""
  2095.      ZForceKeyboard = ZFalse
  2096.      IF ZMacroSave > 0 THEN _
  2097.         ZGSRAra$(ZMacroSave) = ZUserIn$ : _
  2098.         ZMacroSave = 0 : _
  2099.         GOTO 1632
  2100.      IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
  2101.         CALL WipeLine (38) : _
  2102.         IF NOT ZNo THEN _
  2103.            GOTO 1632 _
  2104.         ELSE ZWasQ = 0 : _
  2105.              ZMacroTemplate$ = "" : _
  2106.              ZDistantTGet = 0 : _
  2107.              ZNo = ZFalse : _
  2108.              GOTO 1633
  2109.      IF ZMacroActive THEN _
  2110.         ZLastIndex = ZWasQ : _
  2111.         FirstIndex = 1: _
  2112.         ZMacroActive = NOT EOF(6) : _
  2113.         EXIT SUB
  2114.      IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
  2115.         EXIT SUB
  2116.      IF MacroIndex OR ZSubParm < 3 THEN _
  2117.         MacroIndex = 1 _
  2118.      ELSE MacroIndex = ZAnsIndex
  2119.      CALL NoPath (ZUserIn$(MacroIndex),Found)
  2120.      IF Found THEN _
  2121.         EXIT SUB
  2122.      CALL CheckMacro (ZUserIn$(MacroIndex),Found)
  2123.      IF Found THEN _
  2124.         ZStoreParseAt = ZAnsIndex : _
  2125.         GOTO 1525
  2126.      EXIT SUB
  2127. 1632 ZUserIn$ = ""
  2128.      ZForceKeyboard = ZFalse
  2129. 1633 GOSUB 1580
  2130.      ZWasQ = 1
  2131.      GOTO 1525
  2132. 1635 IF LEN(ZUserIn$) = 0 THEN _
  2133.         GOTO 1525
  2134.      ZUserIn$ = LEFT$(ZUserIn$,LEN(ZUserIn$)-1)
  2135.      CALL LPrnt(ZLocalBksp$,0)
  2136.      IF SendRemote THEN _
  2137.         CALL PutCom(ZBackSpace$)
  2138.      GOTO 1525
  2139.      END SUB
  2140. 1636 ' $SUBTITLE: 'RingCaller - sub to use sound + screen emphasis'
  2141. ' $PAGE
  2142. '
  2143. '  NAME    -- RingCaller
  2144. '
  2145. '  INPUTS  --     PARAMETER                    MEANING
  2146. '                 ZOutTxt$                           STRING TO EMPHASIZE
  2147. '
  2148. '  OUTPUTS --  none
  2149. '
  2150. '  PURPOSE --  Rings the users bell before and after string
  2151. '              (but not snooping sysop) and adds emphasis around
  2152. '              message sent.
  2153. '
  2154.      SUB RingCaller STATIC
  2155.      WasX$ = LEFT$(ZBellRinger$,-ZLocalUser)
  2156.      CALL PutCom (ZBellRinger$)
  2157.      CALL LPrnt (WasX$,0)
  2158.      ZSubParm = 2
  2159.      ZOutTxt$ = ZEmphasizeOn$ + ZOutTxt$ + ZEmphasizeOff$
  2160.      CALL TPut
  2161.      CALL PutCom (ZBellRinger$)
  2162.      CALL LPrnt (WasX$,0)
  2163.      END SUB
  2164. 1637 ' $SUBTITLE: 'ParseIt - subroutine to parse a string'
  2165. ' $PAGE
  2166. '
  2167. '  NAME    -- ParseIt
  2168. '
  2169. '  INPUTS  --     PARAMETER                    MEANING
  2170. '                 ZUserIn$                     STRING TO PARSE
  2171. '
  2172. '  OUTPUTS --  ZWasQ                           NUMBER PARSED
  2173. '              ZUserIn$()                      PARSED STRINGS
  2174. '
  2175. '  PURPOSE --  To parse a string into pieces.  Uses semicolon
  2176. '              if exists, otherwise space, otherwise comma
  2177. '
  2178.      SUB ParseIt STATIC
  2179.      ZWasA = INSTR(ZUserIn$,";")
  2180.      IF ZWasA > 0 THEN _
  2181.         ParseChar$ = ";" _
  2182.      ELSE IF ZUserIn$ <> SPACE$(LEN(ZUserIn$)) THEN _
  2183.              CALL Trim (ZUserIn$) : _
  2184.              WasX$ = ZUserIn$ : _
  2185.              ZWasA = INSTR(ZUserIn$,"  ") : _
  2186.              WHILE ZWasA > 0 : _
  2187.                 ZUserIn$ = LEFT$(ZUserIn$,ZWasA - 1) + _
  2188.                      MID$(ZUserIn$,ZWasA + 1) : _
  2189.                 ZWasA = INSTR(ZWasA,ZUserIn$,"  ") : _
  2190.              WEND : _
  2191.              ZWasA = INSTR(ZUserIn$," ") : _
  2192.              IF ZWasA > 1 THEN _
  2193.                 ParseChar$ = " " _
  2194.              ELSE ZWasA = INSTR(ZUserIn$,",") : _
  2195.                   ParseChar$ = ","
  2196.      IF ZWasA > 1 THEN _
  2197.         GOTO 1639
  2198.      ZWasDF$ = ZUserIn$
  2199.      CALL AllCaps (ZWasDF$)
  2200.      IF ZWasDF$ = "NS" THEN _
  2201.          ZUserIn$ = "C" : _
  2202.          ZNonStop = ZTrue
  2203.      ZUserIn$(ZStoreParseAt) = ZUserIn$
  2204.      ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC)
  2205.      GOTO 1642
  2206. 1639 ZUserIn$(ZStoreParseAt) = LEFT$(ZUserIn$,ZWasA - 1)
  2207.      ZWasA = ZWasA + 1
  2208.      ZEOL = ZFalse
  2209. 1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
  2210.      ZWasC = ZWasB-ZWasA
  2211.      IF ZWasC < 1 THEN _
  2212.         ZEOL = ZTrue : _
  2213.         ZWasC = 128
  2214.      ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
  2215.      IF ZWasDF$ <> "" THEN _
  2216.         ZWasQ = ZWasQ + 1 : _
  2217.         ZStoreParseAt = ZStoreParseAt + 1 : _
  2218.         ZUserIn$(ZStoreParseAt) = ZWasDF$ : _
  2219.         CALL AllCaps(ZWasDF$) : _
  2220.         WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";") : _
  2221.         IF WasX > 0 THEN _
  2222.            ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC) : _
  2223.            ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4) : _
  2224.            IF ZWasQ > 0 AND WasX < 7 THEN _
  2225.               ZWasQ = ZWasQ - 1 : _
  2226.               ZStoreParseAt = ZStoreParseAt - 1
  2227.      IF NOT ZEOL AND ZWasQ < 50 THEN _
  2228.         ZWasA = ZWasB + 1 : _
  2229.         GOTO 1640
  2230.      IF ParseChar$ <> ";" THEN _
  2231.         ZUserIn$ = WasX$
  2232. 1642 ZStackC = ZFalse
  2233.      END SUB
  2234. 1650 ' $SUBTITLE: 'PopCmdStack - prompt for value with command stack check'
  2235.      SUB PopCmdStack STATIC
  2236.      CALL CheckCarrier
  2237.      IF ZSubParm = -1 THEN _
  2238.         ZLastIndex = 0 : _
  2239.         ZWasQ = 0 : _
  2240.         EXIT SUB
  2241.      ZWasQ = 1
  2242. 1651 IF ZAnsIndex < ZLastIndex THEN _
  2243.         ZAnsIndex = ZAnsIndex + 1 : _
  2244.         ZUserIn$ = ZUserIn$(ZAnsIndex) : _
  2245.         IF MID$(ZLastCommand$,2,1) <> " " AND (NOT ZStackC) AND ZAnsIndex > 1 AND INSTR("Cc",ZUserIn$) > 0 AND LEN(ZUserIn$) = 1 THEN _ ' KG070901
  2246.            GOTO 1651 _
  2247.         ELSE ZSubParm = 3 : _
  2248.              ZTurboKey = 0 : _
  2249.              CALL TGet : _
  2250.              GOTO 1652
  2251.      ZLastIndex = 0
  2252.      ZAnsIndex = 1
  2253.      ZSubParm = 1
  2254.      ZSearchingAll = ZFalse
  2255.      CALL TGet
  2256.      ZLastIndex = ZWasQ
  2257. 1652 IF ZStoreParseAt > ZLastIndex THEN _
  2258.         IF ZLastIndex > 0 THEN _
  2259.            ZLastIndex = ZStoreParseAt
  2260.      ZStackC = ZFalse
  2261.      ZParseOff = ZFalse
  2262.      END SUB
  2263. 1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232'
  2264. ' $PAGE
  2265. '
  2266. '  NAME    -- SetBaud
  2267. '
  2268. '  INPUTS  --     PARAMETER                    MEANING
  2269. '             ZBaudRateDivisor   NUMBER TO DIVIDE THE 8250 CHIP'S
  2270. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  2271. '                                 BAUD RATE TO THE USER'S BAUD
  2272. '                                 RATE (INDEPENDENT OF THE BAUD
  2273. '                                 RATE USED TO OPEN THE COMM. PORT)
  2274. '
  2275. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2276. '            RATE              PCjr         PC AND XT
  2277. '              50             2237             2304
  2278. '              75             1491             1536
  2279. '             110             1017             1047
  2280. '             134.5            832              857
  2281. '             150              746              768
  2282. '             300              373              384
  2283. '             600              186              192
  2284. '            1200               93               96
  2285. '            1800               62               64
  2286. '            2000               56               58
  2287. '            2400               47               48
  2288. '            3600               31               32
  2289. '            4800               23               24
  2290. '            7200          not available         16
  2291. '            9600          not available         12
  2292. '           19200          not available          6
  2293. '           38400               "                 3
  2294. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  2295. '
  2296. '  PURPOSE -- To set the baud rate in the RS232 interface
  2297. '             inpependent of the baud rate the communications port
  2298. '             was opened at
  2299. '
  2300.       SUB SetBaud STATIC
  2301.      IF NOT ZKeepInitBaud THEN _
  2302.         ZTalkToModemAt$ =  MID$(ZBaudRates$,(-5 * ZBPS),5) _
  2303.      ELSE ZTalkToModemAt$ = ZModemInitBaud$
  2304.      CALL Trim (ZTalkToModemAt$)
  2305.      IF LEN(ZTalkToModemAt$) < 5 THEN _
  2306.         ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _
  2307.                             ZTalkToModemAt$
  2308.      IF ZEightBit THEN_
  2309.         Parity = 2 : _                                    ' No PARITY
  2310.         DataBits = 3 : _                                  ' 8 DATA BITS
  2311.         StopBits = 0 _                                    ' 1 STOP BIT
  2312.      ELSE Parity = 3 : _                                  ' EVEN PARITY
  2313.           DataBits = 2 : _                                ' 7 DATA BITS
  2314.           StopBits = 0                                    ' 1 STOP BIT
  2315.      ComSpeed! = VAL(ZTalkToModemAt$)
  2316.      IF ComSpeed! > 19200 THEN _
  2317.         IF ZFossil THEN _                                 ' JM051201
  2318.            WasI = &H9600 _
  2319.         ELSE WasI = 19200 _
  2320.      ELSE WasI = ComSpeed!
  2321.      IF ZFossil THEN _
  2322.         CALL FosSpeed(ZComPort,WasI,Parity,DataBits,StopBits) : _
  2323.         EXIT SUB
  2324.      IF ComSpeed! = 2400 THEN _
  2325.         ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _
  2326.      ELSE IF ComSpeed! = 1200 THEN _
  2327.         ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _
  2328.      ELSE IF ComSpeed! = 9600 THEN _
  2329.         ZBaudRateDivisor = &HC _
  2330.      ELSE IF ComSpeed! = 300 THEN _
  2331.         ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _
  2332.      ELSE IF ComSpeed! = 450 THEN _
  2333.         ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _
  2334.      ELSE IF ComSpeed! = 4800 THEN _
  2335.         ZBaudRateDivisor = &H18 _
  2336.      ELSE IF ComSpeed! = 19200 THEN _
  2337.         ZBaudRateDivisor = &H6 _
  2338.      ELSE IF ComSpeed! = 38400 THEN _
  2339.         ZBaudRateDivisor = &H3
  2340.      MostSignifByte = FIX (ZBaudRateDivisor / 256)
  2341.      LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256)
  2342.      LineCntlStatus = INP(ZLineCntlReg)
  2343.      MSBSave = INP(ZMSB)
  2344.      OUT ZMSB,0
  2345.      OUT ZLineCntlReg,LineCntlStatus OR 128
  2346.      OUT ZLSB,LeastSignifByte
  2347.      OUT ZMSB,MostSignifByte
  2348.      OUT ZLineCntlReg,LineCntlStatus
  2349.      OUT ZMSB,MSBSave
  2350.      END SUB
  2351. 2018 ' $SUBTITLE: 'MessageTo - subroutine to get who a message is to'
  2352. ' $PAGE
  2353. '
  2354. '  NAME    -- MessageTo
  2355. '
  2356. '  INPUTS  --     PARAMETER                    MEANING
  2357. '              HighestUserRecord
  2358. '
  2359. '  OUTPUTS --  MsgTo$              Who message is to
  2360. '              RcvrRecNum         User record # of who to
  2361. '
  2362. '  PURPOSE --  Asks who a message is to and determines if receiver exists
  2363. '
  2364.      SUB MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC
  2365.      Temp$ = MsgFrom$
  2366.      CALL Trim (Temp$)
  2367. 2020 IF MsgTo$ <> "" THEN _
  2368.         GOTO 2032
  2369.      ZOutTxt$ = "To [A]ll,S)ysop, or name"
  2370.      CALL SkipLine (1)
  2371.      ZParseOff = ZTrue
  2372.      GOSUB 2033
  2373.      IF LEN(ZUserIn$) > 30 THEN _
  2374.         CALL QuickTPut1 ("30 Char. Max") : _
  2375.         GOTO 2020
  2376. 2030 Found = ZTrue
  2377.      RcvrRecNum = 0
  2378.      IF ZWasQ = 0 THEN _
  2379.         MsgTo$ = "ALL" _
  2380.      ELSE CALL AllCaps (ZUserIn$) : _
  2381.           IF ZUserIn$ = "A" THEN _
  2382.              MsgTo$ = "ALL" : _
  2383.              EXIT SUB _
  2384.           ELSE IF ZUserIn$ = "S" THEN _
  2385.              MsgTo$ = "SYSOP" _
  2386.           ELSE MsgTo$ = ZUserIn$
  2387. 2032 IF MsgTo$ <> "ALL" THEN _
  2388.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  2389.            ZWasDF = INSTR(MsgTo$+" @"," @") : _
  2390.            TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _
  2391.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  2392.            IF NOT Found THEN _
  2393.               ZLastIndex = 0 : _
  2394.               RcvrRecNum = 0 : _
  2395.               IF NOT ZReply THEN _
  2396.                  ZOutTxt$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2397.                  ZTurboKey = -ZTurboKeyUser : _
  2398.                  ZLastIndex = 0 : _
  2399.                  GOSUB 2033 : _
  2400.                  ZWasZ$ = ZUserIn$(1) : _
  2401.                  CALL AllCaps (ZWasZ$) : _
  2402.                  IF ZWasZ$ <> "C" THEN _
  2403.                     MsgTo$ = "" : _
  2404.                     IF ZWasZ$ <> "Q" THEN _
  2405.                        GOTO 2020
  2406.      IF MsgTo$ = Temp$ THEN _
  2407.         ZOutTxt$ = "Msg would be from and to SAME PERSON!  Really do this (Y,[N])" : _
  2408.         ZLastIndex = 0 : _
  2409.         GOSUB 2033 : _
  2410.         IF NOT ZYes THEN _
  2411.            MsgTo$ = ""
  2412.      EXIT SUB
  2413. 2033 CALL PopCmdStack
  2414.      IF ZSubParm < 0 THEN _
  2415.         EXIT SUB
  2416.      RETURN
  2417.      END SUB
  2418. 2055 ' $SUBTITLE: 'MsgProt - gets protection wanted for a message'
  2419. ' $PAGE
  2420. '
  2421. '  NAME    -- MsgProt
  2422. '
  2423. '  INPUTS  --     PARAMETER                    MEANING
  2424. '                 MsgTo$
  2425. '                 Found
  2426. '
  2427. '  OUTPUTS --  ZPswd$                Protection desired
  2428. '
  2429. '  PURPOSE --  Sets protection desired for a new message
  2430. '
  2431.      SUB MsgProt (MsgTo$,Found,MsgPswd$) STATIC
  2432.      IF MsgTo$ = "ALL" THEN _
  2433.         GOTO 2090
  2434. 2060 ZOutTxt$ = "Make message p(U)blic, p(R)ivate, (P)assword protected, (H)elp"
  2435.      IF MsgPswd$ = "^READ^" THEN _
  2436.         DefaultProt$ = "R" : _
  2437.         GOTO 2065
  2438.      IF LEFT$(MsgPswd$,1) = "!" THEN _
  2439.         DefaultProt$ = "P" _
  2440.      ELSE _
  2441.         DefaultProt$ = "U"
  2442. 2065 MID$(ZOutTxt$,INSTR(ZOutTxt$,"("+DefaultProt$+")"),3) = "["+DefaultProt$+"]"
  2443.      ZTurboKey = -ZTurboKeyUser
  2444.      GOSUB 2096
  2445.      IF ZWasQ = 0 THEN _
  2446.         ZUserIn$(ZAnsIndex) = DefaultProt$
  2447.      ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
  2448.      CALL AllCaps (ZWasZ$)
  2449.      ON INSTR("RUPH",ZWasZ$) GOTO 2075,2090,2075,2070
  2450.      GOTO 2060
  2451. '
  2452. ' **  DISPLAY MESSAGE PROTECT HELP   *
  2453. '
  2454. 2070 CALL BufFile (ZHelp$(3),WasX)
  2455.      GOTO 2060
  2456. '
  2457. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
  2458. '
  2459. 2075 IF MsgTo$ = "ALL" THEN _
  2460.         CALL QuickTPut1 ("Msg to ALL cannot be private") : _
  2461.         GOTO 2060
  2462.      IF ZWasZ$ = "P" THEN _
  2463.         GOTO 2088
  2464. 2081 CALL QuickTPut1 ("Sending private mail to " + MsgTo$)
  2465. 2084 MsgPswd$ = "^READ^"
  2466.      EXIT SUB
  2467. 2085 ZOutTxt$ = "Password"
  2468.      GOSUB 2096
  2469.      IF ZWasQ = 0 THEN _
  2470.         IF LEFT$(MsgPswd$,1) = "!" THEN _
  2471.            MsgPswd$ = MID$(MsgPswd$,2) : _
  2472.            CALL QuickTPut1 ("Password is " + MsgPswd$) : _
  2473.            RETURN _
  2474.         ELSE _
  2475.         GOTO 2085
  2476.      IF LEN(ZUserIn$) > WasL THEN _
  2477.         CALL QuickTPut1 (STR$(WasL) + " Chars. max") : _
  2478.         GOTO 2085
  2479.      IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _
  2480.         CALL QuickTPut1 ("Password can't begin with '!'") : _
  2481.         GOTO 2085
  2482.      RETURN
  2483. '
  2484. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
  2485. '
  2486. 2088 ZOutTxt$ = "Receiver(s) MUST know password to read msg.  Use password (Y/[N])"
  2487.      ZTurboKey = -ZTurboKeyUser
  2488.      GOSUB 2096
  2489.      IF NOT ZYes THEN _
  2490.         GOTO 2070
  2491.      WasL = 14
  2492.      WasA1$ = "!"
  2493.      GOSUB 2085
  2494.      CALL AllCaps (ZUserIn$)
  2495.      GOTO 2092
  2496. '
  2497. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  2498. '
  2499. 2090 WasL = 15
  2500.      WasA1$ = ""
  2501.      ZUserIn$ = "^KILL^"
  2502. 2092 MsgPswd$ = WasA1$ + ZUserIn$
  2503.      EXIT SUB
  2504. 2093 ZTurboKey = -ZTurboKeyUser
  2505. 2094 ZSubParm = 1
  2506.      CALL TGet
  2507. 2095 IF ZSubParm = -1 THEN _
  2508.         EXIT SUB
  2509.      RETURN
  2510. 2096 CALL PopCmdStack
  2511.      GOTO 2095
  2512.      END SUB
  2513. 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
  2514. ' $PAGE
  2515. '
  2516. '  NAME    -- WhoCheck
  2517. '
  2518. '  INPUTS  --   PARAMETER                    MEANING
  2519. '              WhoFind$                User to find
  2520. '
  2521. '  OUTPUTS --  WhoFound                Whether user found
  2522. '              UserNumFound           Record # of user
  2523. '
  2524. '  PURPOSE --  Validate that user record exists.  Sysop
  2525. '              counted as found even if lack user record.
  2526. '
  2527.      SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
  2528.      UserNumFound = 0
  2529.      IF ZStartHash <> 1 THEN _
  2530.         WhoFound = ZTrue : _
  2531.         EXIT SUB
  2532.      Work128$ = ZUserRecord$
  2533.      WhoFound = ZFalse
  2534.      ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
  2535.                 INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0)
  2536.      CALL OpenUser (HighestUserRecord)
  2537.      FIELD 5, 128 AS ZUserRecord$
  2538.      IF ToSysop THEN _
  2539.         WasX$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  2540.      ELSE WasX$ = WhoFind$
  2541.      ZWasDF = INSTR(WasX$+"@","@")
  2542.      WasX$ = LEFT$(WasX$,ZWasDF)
  2543.      IF LEN(WasX$) > 1 THEN _
  2544.         CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
  2545.                        0,0,HighestUserRecord,WhoFound,_
  2546.                        UserNumFound,ZWasSL)
  2547.      LSET ZUserRecord$ = Work128$
  2548.      IF NOT WhoFound THEN _
  2549.         IF ToSysop THEN _
  2550.            WhoFound = ZTrue _
  2551.         ELSE CALL QuickTPut1 (WhoFind$ + " not active user")
  2552.      END SUB
  2553. 2618 ' $SUBTITLE: 'EditALine - Edits a line in a message'
  2554. ' $PAGE
  2555. '
  2556. '  NAME    -- EditALine
  2557. '
  2558. '  INPUTS  --     PARAMETER                    MEANING
  2559. '                 WasL                        Line # to edit
  2560. '
  2561. '  OUTPUTS --  ZOutTxt$(WasL)                 Edited line
  2562. '
  2563. '  PURPOSE --  Edit a line in a message.
  2564. '
  2565.      SUB EditALine (WasL) STATIC
  2566. 2620 ZOutTxt$ = "Line #" + _
  2567.           STR$(WasL) + _
  2568.           " is:" + _
  2569.           ZReturnLineFeed$ + _
  2570.           ZOutTxt$(WasL)
  2571.      ZSubParm = 3
  2572.      CALL TPut
  2573.      GOSUB 2695
  2574.      IF NOT ZExpertUser THEN _
  2575.         CALL QuickTPut1 ("Search & replace")
  2576.      ZOutTxt$ = "Search for" + _
  2577.           ZPressEnterExpert$
  2578.      ZMacroMin = 99
  2579.      ZParseOff = ZTrue
  2580.      ZSubParm = 1
  2581.      GOSUB 2694
  2582.      IF ZWasQ = 0 THEN _
  2583.         EXIT SUB
  2584.      ZWasY$ = LEFT$(ZUserIn$,1)
  2585.      IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _
  2586.         IF LEN(ZUserIn$) > 2 THEN _
  2587.            WasX = INSTR(2,ZUserIn$,ZWasY$) : _
  2588.            IF WasX < LEN(ZUserIn$) THEN _
  2589.               IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _
  2590.                  ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _
  2591.                  WasX = WasX - 1 : _
  2592.                  GOTO 2622
  2593.      WasX = INSTR(ZUserIn$,";")
  2594. 2622 IF WasX > 0 THEN _
  2595.         WasX$ = LEFT$(ZUserIn$,WasX-1) : _
  2596.         ZWasY$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-WasX) : _
  2597.         GOTO 2660
  2598.      WasX$ = ZUserIn$
  2599.      ZOutTxt$ = "And replace by"
  2600.      ZParseOff = ZTrue
  2601.      ZSubParm = 1
  2602.      ZMacroMin = 99
  2603.      GOSUB 2694
  2604.      ZWasY$ = ZUserIn$
  2605. 2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$)
  2606.      IF WasX = 0 THEN _
  2607.         CALL QuickTPut1 ("<" + WasX$ + "> not found in line" + STR$(WasL)) : _
  2608.         GOTO 2620
  2609. 2670 ZFF = LEN(WasX$)
  2610.      WasJJ = LEN(ZWasY$)
  2611.      IF ZFF = WasJJ THEN _
  2612.         MID$(ZOutTxt$(WasL),WasX) = ZWasY$ : _
  2613.         GOTO 2620
  2614. 2690 ZWasDF$ = LEFT$(ZOutTxt$(WasL),WasX - 1)
  2615.      ZOutTxt$(WasL) = ZWasDF$ + _
  2616.              ZWasY$ + _
  2617.              MID$(ZOutTxt$(WasL),WasX + ZFF)
  2618.      IF LEN(ZOutTxt$(WasL)) > ZRightMargin THEN _
  2619.         CALL WordWrap (ZRightMargin, ZLinesInMsg, ZOutTxt$())
  2620.      GOTO 2620
  2621. 2694 CALL TGet
  2622. 2695 IF ZSubParm > -1 THEN _
  2623.         RETURN
  2624.      END SUB
  2625. 3700 ' $SUBTITLE: 'LineEdit  - subroutine to produce edited line'
  2626. ' $PAGE
  2627. '
  2628. '  NAME    -- LineEdit
  2629. '
  2630. '  INPUTS  -- PARAMETER             MEANING
  2631. '             ZBackArrow$
  2632. '             ZBackSpace$
  2633. '             ZCarriageReturn$
  2634. '             ZLineFeed$
  2635. '             ZLineMes$          BUFFER SPACE TO USE FOR HOLDING LINE
  2636. '             ZLocalUser
  2637. '             MaxLen             MAXIMUM LENGTH OF STRING TO INPUT
  2638. '             MsgLine            WHERE IN ZOutTxt$() TO PUT THE EDITED LINE
  2639. '             ZRightMargin
  2640. '             ZSnoop
  2641. '             ZStopInterrupts
  2642. '             ZWaitExpired
  2643. '
  2644. '  OUTPUTS -- ZOutTxt$(MsgLine)  EDITED LINE
  2645. '
  2646. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  2647. '             string space.
  2648. '
  2649.      SUB LineEdit (MsgLine,MaxLen) STATIC
  2650.      TabToSpace = 0
  2651.      LSET ZLineMes$ = ZOutTxt$(MsgLine)
  2652.      Col = LEN(ZOutTxt$(MsgLine))
  2653.      ZStopInterrupts = ZTrue
  2654.      WasXXX = MaxLen - 3
  2655.      ZWaitExpired = ZFalse
  2656.      GOTO 3782
  2657. 3720 Col = Col + 1
  2658.      ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2659. 3730 IF TabToSpace > 0 THEN _
  2660.         WasX$ = " " : _
  2661.         TabToSpace = TabToSpace - 1 : _
  2662.         GOTO 3750
  2663.      CALL FindFKey
  2664.      IF ZSubParm < 0 THEN _
  2665.         EXIT SUB
  2666.      WasX$ = ZKeyPressed$
  2667.      IF WasX$ = "" THEN _
  2668.         IF ZLocalUser THEN _
  2669.            GOTO 3733 _
  2670.         ELSE GOTO 3732
  2671.      IF WasX$ = ZEscape$ THEN _
  2672.         ZKeyPressed$ = WasX$ : _
  2673.         EXIT SUB
  2674.      SendRemote = ZTrue
  2675.      WasZ = INSTR(ZLineEditChk$,WasX$)
  2676.      IF WasZ < 1 THEN _
  2677.         GOTO 3750 _
  2678.      ELSE IF WasZ > 4 THEN _
  2679.              GOTO 3870 _
  2680.      ELSE IF WasZ = 1 THEN _
  2681.              GOTO 3810
  2682.      IF ZLocalUser THEN _
  2683.         GOTO 3730
  2684. 3732 IF ZCommPortStack$ <> "" THEN _
  2685.         WasX$ = LEFT$(ZCommPortStack$,1) : _
  2686.         ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  2687.         GOTO 3738
  2688.      CALL EofComm (Char)
  2689.      IF Char <> -1 THEN _
  2690.         GOTO 3736
  2691.      CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1)
  2692.      IF TempElapsed! <=0 THEN _
  2693.         ZWaitExpired = ZTrue : _
  2694.         EXIT SUB
  2695. 3733 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1)
  2696.      IF TempElapsed! <=0 THEN _
  2697.         ZWaitExpired = ZTrue : _
  2698.         Col = Col - 1 : _
  2699.         GOTO 3850
  2700.      CALL Carrier
  2701.      IF ZSubParm THEN _
  2702.         EXIT SUB
  2703.      GOTO 3730
  2704. 3736 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2705. 3737 CALL GetCom (WasX$)
  2706. 3738 SendRemote = ZRemoteEcho
  2707. 3740 ON INSTR(ZLineEditChk$,WasX$) GOTO 3810,3730,3730,3730, _
  2708.                                    3870,3870,3870,3870,3870
  2709. 3750 IF SendRemote THEN _
  2710.         CALL PutCom(WasX$)
  2711.      CALL LPrnt (WasX$, 0)
  2712.      IF WasX$ = ZCarriageReturn$ THEN _
  2713.         Col = Col - 1 : _
  2714.         GOTO 3850
  2715. 3770 IF Col > WasXXX THEN _
  2716.         IF WasX$ = " " THEN _
  2717.            CALL SkipLine (1) : _
  2718.            GOTO 3860
  2719. 3780 MID$(ZLineMes$,Col) = WasX$
  2720. 3782 IF Col < MaxLen THEN _
  2721.         GOTO 3720
  2722.      WasZ = Col
  2723. 3800 IF WasZ < 1 THEN _
  2724.         WasZ = Col-1 : _
  2725.         GOTO 3820
  2726.      IF MID$(ZLineMes$,WasZ,1) = " " THEN _
  2727.         GOTO 3820
  2728.      WasZ = WasZ - 1
  2729.      GOTO 3800
  2730. 3810 TabToSpace = 5 - (Col MOD 5)
  2731.      GOTO 3730
  2732. 3820 IF (NOT ZRemoteEcho) AND (NOT ZLocalUser) THEN _
  2733.         CALL SkipLine (1) : _
  2734.         GOTO 3860
  2735.      Col = MaxLen - WasZ
  2736.      IF ZSnoop THEN _
  2737.         IF (POS(0) > Col) AND (Col > 0) THEN _
  2738.            LOCATE ,POS(0)-Col: _
  2739.            CALL LPrnt(STRING$(Col,32),0)
  2740. 3830 IF ZRemoteEcho THEN _
  2741.         CALL PutCom (STRING$(Col,8) + STRING$(Col,32))
  2742. 3840 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,WasZ)
  2743.      ZOutTxt$(MsgLine + 1) = MID$(ZLineMes$,WasZ + 1,Col)
  2744.      CALL SkipLine (1)
  2745.      GOTO 3891
  2746. 3850 IF SendRemote AND ZLineFeeds THEN _
  2747.         CALL PutCom(ZLineFeed$)
  2748. 3860 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,Col)
  2749.      GOTO 3891
  2750. 3870 IF Col = 1 THEN _
  2751.         GOTO 3730
  2752.      Col = Col-2
  2753. 3880 CALL LPrnt(ZLocalBksp$,0)
  2754. 3885 IF SendRemote THEN _
  2755.         CALL PutCom (ZBackSpace$)
  2756. 3890 GOTO 3720
  2757. 3891 CALL Carrier
  2758.      END SUB
  2759. 3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages'
  2760. ' $PAGE
  2761. '
  2762. '  NAME    -- KillMsg
  2763. '
  2764. '  INPUTS  --     PARAMETER                    MEANING
  2765. '              MsgToKill                   MESSAGE NUMBER TO KILL
  2766. '              ActiveMessages              NUMBER ACTIVE MESSAGES
  2767. '
  2768. '  OUTPUTS --  NONE
  2769. '
  2770. '  PURPOSE --  To kill/delete old or unnecessary messages
  2771. '
  2772.      SUB KillMsg (MsgToKill,ActiveMessages) STATIC
  2773. '
  2774.      FIELD #1,128 AS ZMsgRec$
  2775.      WasQX = 1
  2776. 3955 IF WasQX > ActiveMessages THEN _
  2777.         ZOutTxt$ = "No such msg #" + _
  2778.              STR$(MsgToKill) : _
  2779.         GOTO 4031
  2780.      IF ZMsgPtr(WasQX,2) = MsgToKill AND MsgToKill => 1 THEN _
  2781.         GOTO 3970
  2782.      WasQX = WasQX + 1
  2783.      GOTO 3955
  2784. 3970 ZSubParm = 3
  2785.      CALL FileLock
  2786.      GET 1,ZMsgPtr(WasQX,1)
  2787.      IF ZUserSecLevel >= ZSecKillAny THEN _
  2788.         GOTO 4030
  2789. 3980 ZWasZ$ = MID$(ZMsgRec$,101,15)
  2790.      CALL Trim (ZWasZ$)
  2791.      IF LEN(ZWasZ$) = 0 THEN _
  2792.         GOTO 4030
  2793. 3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _
  2794.         CALL ChkMsgName (MsgToCaller,MsgFromCaller) : _
  2795.         IF (MsgFromCaller or MsgToCaller) THEN _
  2796.            GOTO 4030 _
  2797.         ELSE ZMsgPswd = ZTrue : _
  2798.              ZAttemptsAllowed = 0 : _
  2799.              ZOutTxt$ = "Only sender & receiver can kill" : _
  2800.              GOTO 4031
  2801. 4000 IF LEFT$(ZWasZ$,1) = "!" THEN _
  2802.         ZWasZ$ = MID$(ZWasZ$,2)
  2803. 4010 ZPswdSave$ = ZWasZ$ + _
  2804.                       SPACE$(15 - LEN(ZWasZ$))
  2805.      ZAttemptsAllowed = 1
  2806.      ZMsgPswd = ZTrue
  2807.      CALL PassWrd
  2808.      IF ZPswdFailed THEN _
  2809.         GOTO 4031
  2810. 4030 MID$(ZMsgRec$,116,1) = ZDeletedMsg$
  2811.      PUT 1,LOC(1)
  2812.      ZSubParm = 4
  2813.      CALL FileLock
  2814.      ZOutTxt$ = "Killed Msg # " + _
  2815.           STR$(MsgToKill)
  2816.      CALL UpdtCalr (ZOutTxt$,1)
  2817. 4031 ZSubParm = 5
  2818.      CALL TPut
  2819.      END SUB
  2820. 4554 ' $SUBTITLE: 'SetThread - Sets up the interface for threading'
  2821. ' $PAGE
  2822. '
  2823. '  NAME    -- SetThread
  2824. '
  2825. '  INPUTS  --     PARAMETER                    MEANING
  2826. '                 CurMsgNum                 Current message number
  2827. '                 CurSubj$                  Current message subject
  2828. '
  2829. '  OUTPUTS --  ZUserIn$()                   Search msg by string
  2830. '              ZWasQ                        0 if thread cancelled
  2831. '
  2832. '  PURPOSE --  Find out how the caller wants to thread -
  2833. '              i.e. search messages by matching subject -
  2834. '              forward from current, back from current,
  2835. '              or forward from top of messages
  2836. '
  2837.      SUB SetThread (CurMsgNum,CurSubj$) STATIC
  2838.      IF ZWasQ > 1 THEN _
  2839.         ZWasZ$ = ZUserIn$(2) : _
  2840.         GOTO 4657
  2841. 4656 ZOutTxt$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)"
  2842.      ZTurboKey = -ZTurboKeyUser
  2843.      ZSubParm = 1
  2844.      CALL TGet
  2845.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2846.         EXIT SUB
  2847.      ZWasZ$ = ZUserIn$(1)
  2848. 4657 ZWasZ$ = LEFT$(ZWasZ$,1)
  2849.      WasX = INSTR("+-1",ZWasZ$)
  2850.      IF WasX = 0 THEN _
  2851.         GOTO 4656
  2852.      ZUserIn$(1) = "R"
  2853.      IF WasX = 1 THEN _
  2854.         CurMsgNum = CurMsgNum + 1 _
  2855.      ELSE IF WasX = 2 THEN _
  2856.              CurMsgNum = CurMsgNum - 1 _
  2857.           ELSE CurMsgNum = 1 : _
  2858.                ZWasZ$ = "+"
  2859.      ZUserIn$(3) = MID$(STR$(CurMsgNum),2) + ZWasZ$
  2860.      IF LEN(CurSubj$) < 4 OR LEFT$(CurSubj$,3) <> "(R)" THEN _
  2861.         ZUserIn$(2) = CurSubj$ _
  2862.      ELSE ZUserIn$(2) = MID$(CurSubj$,4)
  2863.      ZUserIn$(2) = LEFT$(ZUserIn$(2) + "  ",22)
  2864.      ZLastIndex = 3
  2865.      ZAnsIndex = 1
  2866.      ZWasQ = 3
  2867.      END SUB
  2868. 4773 ' $SUBTITLE: 'SysopChat - chat with sysop'
  2869. ' $PAGE
  2870. '
  2871. '  NAME    -- SysopChat
  2872. '
  2873. '  INPUTS  --     PARAMETER                    MEANING
  2874. '  OUTPUTS --  ZWasCM                     True if chat active
  2875. '
  2876. '  PURPOSE --  Lets sysop chat interactively with caller
  2877. '
  2878.      SUB SysopChat STATIC
  2879.      ZWasCM = ZTrue
  2880.      TimeChatStarted! = TIMER
  2881.      ZSubParm = 1
  2882.      CALL Line25
  2883.      ZOutTxt$(2) = ""
  2884. 4775 CALL LineEdit (1,72)
  2885.      IF ZKeyPressed$ = ZEscape$ OR _
  2886.         ZSubParm < 0 THEN _
  2887.         GOTO 4777
  2888.      ZOutTxt$(1) = ""
  2889.      IF ZOutTxt$(2) <> "" THEN _
  2890.         ZOutTxt$ = ZOutTxt$(2) : _
  2891.         ZOutTxt$(1) = ZOutTxt$(2) : _
  2892.         ZOutTxt$(2) = "" _
  2893.      ELSE ZOutTxt$ = ""
  2894.      ZSubParm = 4
  2895.      CALL TPut
  2896.      IF ZSubParm > -1 THEN _
  2897.         GOTO 4775
  2898. 4777 ZWasCM = 0
  2899.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  2900.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  2901.      IF NOT ZLocalUser THEN _
  2902.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2903.      CALL QuickTPut("  Chat over.  BBS resuming",2)
  2904.      END SUB
  2905. 5100 ' $SUBTITLE: 'RemNonAlf - removes non-alpha chars from a string'
  2906. ' $PAGE
  2907. '
  2908. '  NAME    -- RemNonAlf
  2909. '
  2910. '  INPUTS  --     PARAMETER                    MEANING
  2911. '                 Strng$                   String to check
  2912. '                 MinChar                  Remove chars with this
  2913. '                                          ASCII value or lower
  2914. '                 MaxChar                  Remove chars with this
  2915. '                                          ASCII value or higher
  2916. '
  2917. '  OUTPUTS --       Strng$                 String returned
  2918. '  PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2919. '
  2920.      SUB RemNonAlf (Strng$,MinChar,MaxChar) STATIC
  2921.      Last = LEN(Strng$)
  2922.      WasJ = 1
  2923.      WHILE WasJ <= Last
  2924.         WasK = ASC(MID$(Strng$,WasJ))
  2925.         IF WasK > MinChar AND WasK < MaxChar THEN _
  2926.            WasJ = WasJ + 1 _
  2927.         ELSE Strng$ = LEFT$(Strng$,WasJ - 1) + _
  2928.                       RIGHT$(Strng$,Last - WasJ) : _
  2929.              Last = Last - 1
  2930.      WEND
  2931.      END SUB
  2932.  
  2933. 5200 ' $SUBTITLE: 'PageLen - Sets lines per page'
  2934. ' $PAGE
  2935. '
  2936. '  NAME    -- PageLen
  2937. '
  2938. '  INPUTS  --     PARAMETER                    MEANING
  2939. '               ZPageLength              Current page length
  2940. '
  2941. '  OUTPUTS --   ZPageLength              New page length
  2942. '
  2943. '  PURPOSE --  Change default lines per page
  2944. '
  2945.      SUB PageLen STATIC
  2946. 5202 ZOutTxt$ = "CHANGE page length from" + _
  2947.           STR$(ZPageLength) + _
  2948.           " TO (0-255, 0=continuous)"
  2949.      CALL PopCmdStack
  2950.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2951.         CALL QuickTPut1 ("No change") : _
  2952.         EXIT SUB
  2953. 5230 CALL CheckInt (ZUserIn$(ZAnsIndex))
  2954.      IF ZErrCode <> 0 THEN _
  2955.         GOTO 5202
  2956.      IF ZTestedIntValue < 0 OR _
  2957.         ZTestedIntValue > 255 THEN _
  2958.         GOTO 5202
  2959.      ZPageLength = ZTestedIntValue
  2960.      CALL QuickTPut1 ("Page Length Set to" + STR$(ZPageLength))
  2961.      END SUB
  2962. 5507 ' $SUBTITLE: 'Baud450 -- Changes 300 baud to 450'
  2963. ' $PAGE
  2964. '  NAME    -- Baud450
  2965. '
  2966. '  INPUTS  -- PARAMETER             MEANING
  2967. '             ZBPS
  2968. '
  2969. '  OUTPUTS -- ZBPS
  2970. '
  2971. '  PURPOSE -- Allow 300 baud modems to bump up to 450 baud
  2972. '
  2973.      SUB Baud450 STATIC
  2974.      IF ZBPS <> -1 THEN _
  2975.         CALL QuickTPut1 ("Sorry, only 300 baud can change speed") : _
  2976.         EXIT SUB
  2977.      IF ZFossil THEN _
  2978.         CALL QuickTPut1 ("Sorry, no 450 baud under FOSSIL") : _
  2979.         EXIT SUB
  2980.      ZOutTxt$ = "Change to 450 baud (Y,[N])"
  2981.      ZTurboKey = -ZTurboKeyUser
  2982.      ZSubParm = 1
  2983.      CALL TGet
  2984.      IF ZSubParm = -1 OR NOT ZYes THEN _
  2985.         EXIT SUB
  2986. 5510 CALL QuickTPut1 ("Change your baud rate to 450")
  2987.      CALL DelayTime (9)
  2988.      ZWasC = 0
  2989.      ZBPS = -2
  2990.      CALL SetBaud
  2991.      ZOutTxt$ = " and then press [ENTER] until I respond"
  2992.      ZSubParm = 9
  2993.      CALL TGet
  2994. 5530 ZWasC = ZWasC + 1
  2995.      CALL Carrier
  2996.      IF ZSubParm = -1 THEN _
  2997.         EXIT SUB
  2998.      IF ZWasC = 20 THEN _
  2999.         CALL UpdtCalr ("Baud change failed",1) : _
  3000.         ZBPS = -1 : _
  3001.         CALL SetBaud : _
  3002.         EXIT SUB
  3003.      CALL DelayTime (1)
  3004. 5535 CALL EofComm (Char)
  3005.      IF Char = -1 THEN _
  3006.         GOTO 5530
  3007. 5536 CALL PutCom(ZOutTxt$)
  3008.      IF ZOutTxt$ = "" THEN _
  3009.         ZOutTxt$ = " "
  3010.      IF ASC(ZOutTxt$) = 13 THEN _
  3011.         GOTO 5540
  3012.      IF ZSubParm = -1 THEN _
  3013.         EXIT SUB
  3014. 5537 GOTO 5530
  3015. 5540 ZOutTxt$ = "Changed to 450 baud"
  3016.      CALL QuickTPut1 (ZOutTxt$)
  3017.      CALL UpdtCalr (ZOutTxt$,1)
  3018.      ZBPS = -2
  3019.      ZOutTxt$ = ""
  3020.      END SUB
  3021. 9140 ' $SUBTITLE: 'GetTime - subroutine to calculate elapsed time'
  3022. ' $PAGE
  3023. '
  3024. '  NAME    -- GetTime
  3025. '
  3026. '  INPUTS  --     PARAMETER                    MEANING
  3027. '                ZTimeLoggedOn$
  3028. '
  3029. '  OUTPUTS --  ZSessionHour               NUMBER OF HOURS ON
  3030. '              ZSessionMin                NUMBER OF MINUTES ON
  3031. '              ZSessionSec                NUMBER OF SECONDS ON
  3032. '
  3033. '  PURPOSE --  Calculate the elapsed time a user has been on
  3034. '
  3035.      SUB GetTime STATIC
  3036.      CALL CheckTime(ZUserLogonTime!, TempElapsed!, 2)
  3037.      ZSessionHour = TempElapsed! / 3600
  3038.      ZSessionMin = (TempElapsed! - ZSessionHour * 3600!) / 60
  3039.      ZSessionSec = TempElapsed! - (ZSessionHour * 3600! + ZSessionMin * 60!)
  3040.      IF ZSessionSec < 0 THEN _
  3041.         ZSessionSec = ZSessionSec + 60 : _
  3042.         ZSessionMin = ZSessionMin - 1
  3043.      IF ZSessionMin < 0 THEN _
  3044.         ZSessionMin = ZSessionMin + 60 : _
  3045.         ZSessionHour = ZSessionHour - 1
  3046.      END SUB
  3047. 9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts'
  3048. ' $PAGE
  3049. '
  3050. '  NAME    -- DefaultU
  3051. '
  3052. '  INPUTS  --     PARAMETER                    MEANING
  3053. '             ZAutoDownDesired
  3054. '             ZBoldText$              Ansi bold (0 no, 1 yes)
  3055. '             ZCheckBulletLogon
  3056. '             ZExpertUser
  3057. '             ZWasGR
  3058. '             ZLastMsgRead
  3059. '             ZLineFeeds
  3060. '             ZNulls
  3061. '             ZPageLength
  3062. '             ZPromptBell
  3063. '             ZRegDate$
  3064. '             ZReqQuesAnswered
  3065. '             ZRightMargin
  3066. '             ZSkipFilesLogon
  3067. '             ZTimesLoggedOn
  3068. '             ZUpperCase
  3069. '             ZUserOption$
  3070. '             ZUserTextColor          Ansi of color (31-37)
  3071. '             ZUserXferDefault$
  3072. '
  3073. '  OUTPUTS--  USER.OPTONS$
  3074. '
  3075. '  PURPOSE --  To update the user's record with their options.
  3076. '  Meaning of graphics preference stored is as follows: where # is
  3077. '  value stored for the color.  E.g. if graphics perference for text
  3078. '  files is color, and preference for normal text is light yellow,
  3079. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  3080. '  Blue, Purple, Cyan, and White.
  3081. '
  3082. '             normal                  bold
  3083. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  3084. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  3085. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  3086. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  3087. '
  3088.      SUB DefaultU STATIC
  3089.      ZWasA =    -ZPromptBell          -2 * ZExpertUser _
  3090.             -4 * ZNulls               -8 * ZUpperCase _
  3091.            -16 * ZLineFeeds          -32 * ZCheckBulletLogon _
  3092.            -64 * ZSkipFilesLogon    -128 * ZAutoDownDesired _
  3093.           -256 * ZReqQuesAnswered   -512 * ZMailWaiting _
  3094.          -1024 * (NOT ZHiLiteOff)  -2048 * ZTurboKeyUser
  3095.      WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR
  3096.      IF WasX < 1 OR WasX > 255 THEN _
  3097.         WasX = 48
  3098.      LSET ZUserOption$ = _
  3099.         MKI$(ZTimesLoggedOn) + _
  3100.         MKI$(ZLastMsgRead) + _
  3101.         ZUserXferDefault$ + _
  3102.         CHR$(WasX) + _
  3103.         MKI$(ZRightMargin) + _
  3104.         MKI$(ZWasA) + _
  3105.         ZRegDate$ + _
  3106.         CHR$(ZPageLength) + _
  3107.         ZEchoer$
  3108.      END SUB
  3109. 9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
  3110. ' $PAGE
  3111. '
  3112. '  NAME    -- WhosOn
  3113. '
  3114. '  INPUTS  --     PARAMETER                    MEANING
  3115. '                NumNodes                   # of nodes to check
  3116. '                ZActiveMessageFile$        Current message file
  3117. '                ZOrigMsgFile$              Main msg file
  3118. '
  3119. '  OUTPUTS --  None
  3120. '
  3121. '  PURPOSE --  To display who is on each node.
  3122. '
  3123.      SUB WhosOn (NumNodes) STATIC
  3124.      WasA1$ = ZActiveMessageFile$
  3125.      ZActiveMessageFile$ = ZOrigMsgFile$
  3126.      CALL OpenMsg
  3127.      FIELD 1, 128 AS ZMsgRec$
  3128.      FOR NodeIndex = 2 TO NumNodes + 1
  3129.         GET 1,NodeIndex
  3130.         ZOutTxt$ = ZFG1$ + "Node" + _
  3131.              STR$(NodeIndex - 1) + ZFG2$
  3132.         RecIndex = VAL(MID$(ZMsgRec$,44,2))
  3133.         IF RecIndex = 0 THEN _
  3134.            RecIndex = -1
  3135.         WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
  3136.               " BPS: "
  3137.         IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
  3138.            ZWasY$ = "SYSOP" + SPACE$(21) _
  3139.         ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
  3140.         WasAX$ = WasAX$ + ZFG3$ + ZWasY$
  3141.         IF MID$(ZMsgRec$,40,2) <> "-1" THEN _
  3142.            WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22)
  3143.         IF MID$(ZMsgRec$,57,1) = "A" THEN _
  3144.            ZOutTxt$ = ZOutTxt$ + "  Online at " + _
  3145.                 WasAX$ _
  3146.         ELSE IF NOT ZSysop THEN _
  3147.                 ZOutTxt$ = ZOutTxt$ + _
  3148.                      " Waiting for next caller" _
  3149.              ELSE ZOutTxt$ = ZOutTxt$ + _
  3150.                        " Offline at " + _
  3151.                        WasAX$
  3152.         CALL QuickTPut1 (ZOutTxt$)
  3153.         CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  3154.         IF ZNo THEN _
  3155.            NodeIndex = NumNodes + 2
  3156.      NEXT
  3157.      ZActiveMessageFile$ = WasA1$
  3158.      CALL QuickTPut (ZEmphasizeOff$,0)
  3159.      END SUB
  3160. 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
  3161. ' $PAGE
  3162. '
  3163. '  NAME    -- RecoverMsg
  3164. '
  3165. '  INPUTS  --     PARAMETER                    MEANING
  3166. '               MsgToRecover          MESSAGE NUMBER TO RECOVER
  3167. '               FirstMsgRecord        RECORD # FOR First MSG
  3168. '
  3169. '  OUTPUTS --  ActionFlag                 SET TO 0 IF ERROR
  3170. '                                         SET TO -1 IF No ERROR
  3171. '
  3172. '  PURPOSE --  To recover deleted messages.  Note that this is only
  3173. '              possible if you have not compressed your message file
  3174. '              using config.
  3175. '
  3176.       SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag) STATIC
  3177.       FIELD #1,128 AS ZMsgRec$
  3178.       MsgRec = FirstMsgRecord
  3179. 10420 GET 1,MsgRec
  3180.       NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
  3181.       IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _
  3182.          ZWasY$ = "No Msg #" + _
  3183.               STR$(MsgToRecover) : _
  3184.          GOTO 10485
  3185. 10440 IF VAL(MID$(ZMsgRec$,2,4)) <> MsgToRecover THEN _
  3186.          MsgRec = MsgRec + NumRecsInMsg : _
  3187.          GOTO 10420
  3188. 10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _
  3189.          LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _
  3190.                                 ZActiveMessage$ + _
  3191.                                 MID$(ZMsgRec$,117) : _
  3192.          PUT 1,LOC(1) : _
  3193.          ZWasY$ = "Restored Msg #" + _
  3194.               STR$(MsgToRecover) : _
  3195.          ActionFlag = ZTrue : _
  3196.          GOTO 10485
  3197. 10480 ZWasY$ = "Msg #" + _
  3198.            STR$(MsgToRecover) + _
  3199.            " not Dead"
  3200. 10485 CALL QuickTPut1 (ZWasY$)
  3201.       END SUB
  3202. 10600 ' $SUBTITLE: 'UpdateU -- Update the users record at logoff'
  3203. ' $PAGE
  3204. '  NAME    -- UpdateU
  3205. '
  3206. '  INPUTS  -- PARAMETER             MEANING
  3207. '             ZAdjustedSecurity
  3208. '             ZCurDate$
  3209. '             ZDnlds
  3210. '             ZElapsedTime
  3211. '             ZListDir
  3212. '             ZMainUserFileIndex
  3213. '             ZSecsPerSession!
  3214. '             ZUplds
  3215. '             ZUserSecLevel
  3216. '
  3217. '  OUTPUTS -- ZElapsedTime$
  3218. '             ZListNewDate$
  3219. '             ZSecLevel$
  3220. '             ZUserDnlds$
  3221. '             ZUserUplds$
  3222. '
  3223. '  PURPOSE -- Update the user record for the user when the user
  3224. '             exits RBBS-PC.
  3225. '
  3226.       SUB UpdateU (LoggingOff) STATIC
  3227.       IF ZActiveUserName$ = "" OR ZFirstName$ = "" THEN _
  3228.          EXIT SUB
  3229.       IF ZUserFileIndex < 1 THEN _
  3230.          GOTO 10607
  3231.       UpdateDefaults = ZTrue
  3232. 10602 ZSubParm = 6
  3233.       ZWasY$ = ZLastDateTimeOn$
  3234.       CALL FileLock
  3235.       CALL OpenUser (HighestUserRecord)
  3236.       FIELD 5,31 AS ZUserName$, _
  3237.               15 AS ZPswd$, _
  3238.                2 AS ZSecLevel$, _
  3239.               14 AS ZUserOption$,  _
  3240.               24 AS ZCityState$, _
  3241.               3 AS MachineType$, _
  3242.               4 AS ZTodayDl$, _
  3243.               4 AS ZTodayBytes$, _
  3244.               4 AS ZDlBytes$, _
  3245.               4 AS ZULBytes$, _
  3246.               14 AS ZLastDateTimeOn$, _
  3247.                3 AS ZListNewDate$, _
  3248.                2 AS ZUserDnlds$, _
  3249.                2 AS ZUserUplds$, _
  3250.                2 AS ZElapsedTime$
  3251. 10604 GET 5,ZUserFileIndex
  3252.       IF ZActiveUserFile$ = ZOrigUserFile$ THEN _
  3253.          ZUplds = ZGlobalUplds : _
  3254.          ZDnlds = ZGlobalDnlds : _
  3255.          ZDLToday! = ZGlobalDLToday! : _
  3256.          ZBytesToday! = ZGlobalBytesToday! : _
  3257.          ZDLBytes! = ZGlobalDLBytes! : _
  3258.          ZULBytes! = ZGlobalULBytes!
  3259.       LSET ZLastDateTimeOn$ = ZWasY$
  3260.       IF UpdateDefaults THEN _
  3261.          CALL DefaultU
  3262.       IF ZListDir THEN _
  3263.          LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
  3264.                               CHR$(VAL(MID$(ZCurDate$,1,2))) + _
  3265.                               CHR$(VAL(MID$(ZCurDate$,4,2)))
  3266. 10605 LSET ZUserDnlds$ = MKI$(ZDnlds)
  3267.       LSET ZUserUplds$ = MKI$(ZUplds)
  3268.       IF ZEnforceRatios THEN _
  3269.          LSET ZTodayDl$ = MKS$(ZDLToday!) : _
  3270.          LSET ZTodayBytes$ = MKS$(ZBytesToday!) : _
  3271.          LSET ZDlBytes$ = MKS$(ZDLBytes!) : _
  3272.          LSET ZULBytes$ = MKS$(ZULBytes!)
  3273.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  3274.       IF (NOT ZExitToDoors) AND LoggingOff THEN _
  3275.          TempElapsed! = ZElapsedTime + _
  3276.                        (ZSecsUsedSession! - ZTimeCredits!) / 60 : _
  3277.          ZTimeCredits! = 0 _
  3278.       ELSE TempElapsed! = ZElapsedTime - ZExitToDoors*ZMinsInDoors
  3279.       IF TempElapsed! < -32767 THEN _
  3280.          TempElapsed! = -32767 _
  3281.       ELSE IF TempElapsed! > 32767 THEN _
  3282.          TempElapsed! = 32767
  3283.       LSET ZElapsedTime$ = MKI$(TempElapsed!)
  3284.       IF ZAdjustedSecurity THEN _
  3285.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)
  3286.       PUT 5,ZUserFileIndex
  3287.       ZSubParm = 8
  3288.       CALL FileLock
  3289.       IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _
  3290.          ZActiveUserFile$ = ZOrigUserFile$ : _
  3291.          ZUserFileIndex = ZOrigUserFileIndex : _
  3292.          UpdateDefaults = ZFalse : _
  3293.          LSET ZLastDateTimeOn$ = ZOrigDateTimeOn$ : _
  3294.          GOTO 10602
  3295. 10607 IF ZExitToDoors OR NOT LoggingOff THEN _
  3296.          EXIT SUB
  3297.       Temp = ZMinsPerSession
  3298.       IF ZMaxPerDay > 0 THEN _
  3299.          Temp = ZMaxPerDay - TempElapsed! : _
  3300.          IF Temp > ZMinsPerSession THEN _
  3301.             Temp = ZMinsPerSession
  3302.       Temp = -(Temp > 0) * Temp
  3303.       CALL QuickTPut1 (STR$(Temp)+" min left for next call today")
  3304.       CALL QuickTPut1 (ZFirstName$ + ", Thanks and please call again!")
  3305.       IF NOT ZHiLiteOff THEN _
  3306.          CALL QuickTPut1 (ZColorReset$)
  3307.       CALL DelayTime (8 + ZBPS)
  3308.       END SUB
  3309. 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
  3310. ' $PAGE
  3311. '  NAME    -- DosExit
  3312. '
  3313. '  INPUTS  -- PARAMETER             MEANING
  3314. '             ZComPort$
  3315. '             ZDoorsTermType
  3316. '             ZMultiLinkPresent
  3317. '             ZRBBSBat$
  3318. '             ZRedirectIOMethod
  3319. '             ZUseDeviceDriver$
  3320. '
  3321. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3322. '                                      ZRCTTYBat$
  3323. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3324. '
  3325. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
  3326. '             exit to DOS for the remote RBBS-PC sysop
  3327. '
  3328.       SUB DosExit STATIC
  3329.       IF ZMultiLinkPresent AND _
  3330.          ZDoorsTermType > 0 THEN _
  3331.          ZFF = 0 : _
  3332.          GOTO 10950
  3333.       ZOutTxt$(1) = "ECHO OFF"
  3334.       IF ZUseDeviceDriver$ <> "" THEN _
  3335.          Port$ = ZUseDeviceDriver$ _
  3336.       ELSE Port$ = "COM" + RIGHT$(ZComPort$,1)
  3337.       IF ZRedirectIOMethod THEN _
  3338.          ZFF = 5 : _
  3339.          ZOutTxt$(2) = "CTTY " + _
  3340.                  Port$ : _
  3341.          ZOutTxt$(3) = ZDiskForDos$ + _
  3342.                  "COMMAND" : _
  3343.          ZOutTxt$(4) = "CTTY CON" : _
  3344.          ZOutTxt$(5) = ZRBBSBat$ _
  3345.       ELSE ZFF = 3 : _
  3346.            ZOutTxt$(2) = ZDiskForDos$ + _
  3347.                    "COMMAND >" + _
  3348.                    Port$ + _
  3349.                    " <" + _
  3350.                    Port$ : _
  3351.            ZOutTxt$(3) = ZRBBSBat$
  3352. 10950 CALL AMorPM
  3353.       CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
  3354.       CALL QuickTPut1 ("RBBS-PC " + ZVersionID$)
  3355.       CALL QuickTPut1 ("SysOp in Remote Console mode")
  3356.       CALL RBBSExit (ZOutTxt$(),ZFF)
  3357.       END SUB
  3358. 10976 ' $SUBTITLE: 'WordInFile -- Searches a file to find a word'
  3359. ' $PAGE
  3360. '  NAME    -- WordInFile
  3361. '
  3362. '  INPUTS  -- PARAMETER             MEANING
  3363. '             FilName$              FILE TO SEARCH IN
  3364. '             Strng$                STRING TO SEARCH FOR
  3365. '
  3366. '  OUTPUTS -- InFile                WHETHER STRING Found IN FILE
  3367. '
  3368. '  PURPOSE -- Searches for "Strng$" in file "FILNAME$."  Used to
  3369. '             limit doors and questionnaires to those specified
  3370. '             in their menu files.  The "Strng$" is capitalized
  3371. '             but not the lines in the file, so must be exact
  3372. '             case-sensitive match to be found.  The only character
  3373. '             that can immediately proceed or end a name to be
  3374. '             found must be a blank.
  3375. '
  3376.       SUB WordInFile (FilName$,Strng$,InFile) STATIC
  3377.       InFile = ZFalse
  3378.       CALL FindIt (FilName$)
  3379.       IF NOT ZOK THEN _
  3380.          EXIT SUB
  3381.       WasX = 0
  3382.       CALL AllCaps (Strng$)
  3383.       WHILE NOT EOF(2) AND WasX < 1
  3384.          LINE INPUT #2,ZOutTxt$
  3385.          WasY = 1
  3386. 10978    WasX = INSTR(WasY,ZOutTxt$,Strng$)
  3387.          IF WasX < 1 THEN _
  3388.             GOTO 10980
  3389.          WasY = WasX + 1
  3390.          IF WasX > 1 THEN _
  3391.             IF MID$(ZOutTxt$,WasX - 1,1) <> " " THEN _
  3392.                WasX = 0
  3393.          IF WasX > 0 THEN _
  3394.             WasL = LEN(Strng$) : _
  3395.             IF LEN(ZOutTxt$) => (WasX + WasL) THEN _
  3396.                IF MID$(ZOutTxt$,WasX + WasL,1) <> " " THEN _
  3397.                   WasX = 0
  3398.          IF WasX = 0 THEN _
  3399.             GOTO 10978
  3400. 10980 WEND
  3401.       CLOSE 2
  3402.       InFile = (WasX > 0)
  3403.       END SUB
  3404. 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"'
  3405. ' $PAGE
  3406. '  NAME    -- DoorExit
  3407. '
  3408. '  INPUTS  -- PARAMETER             MEANING
  3409. '             ZMultiLinkPresent
  3410. '             ZNodeID$
  3411. '             ZRBBSBat$
  3412. '             ZWasZ$
  3413. '
  3414. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3415. '                                      ZRCTTYBat$
  3416. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3417. '
  3418. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and
  3419. '             exit RBBS-PC to invoke another program
  3420. '
  3421.       SUB DoorExit (ReqDoorsDef) STATIC
  3422.       IF ZWasZ$ = "" OR _
  3423.          ZWasZ$ = "NONE" THEN _
  3424.          EXIT SUB
  3425.       CALL FindIt (ZWasZ$)
  3426.       IF NOT ZOK THEN _
  3427.          GOTO 10986
  3428.       CALL BreakFileName (ZWasZ$,WasX$,ExitTo$,ExitMethod$,ZFalse)
  3429.       ExitMethod$ = ""
  3430.       ZDooredTo$ = ExitTo$
  3431.       CALL FindIt (ZDoorsDef$)
  3432.       IF NOT ZOK THEN _
  3433.          IF ReqDoorsDef THEN _
  3434.             EXIT SUB _
  3435.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3436.               GOTO 10989
  3437. 10985 CALL ReadParms (ZOutTxt$(),8,1)
  3438.       IF ZErrCode > 0 THEN _
  3439.          IF ReqDoorsDef THEN _
  3440.             EXIT SUB _
  3441.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3442.               GOTO 10989
  3443.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  3444.          GOTO 10985
  3445.       CALL CheckInt (ZOutTxt$(2))
  3446.       IF ZErrCode > 0 THEN _
  3447.          ZErrCode = 0 : _
  3448.          GOTO 10985
  3449.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3450.          CALL QuickTPut1 ("Insufficient security for door") : _
  3451.          EXIT SUB
  3452.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  3453.       CALL FindIt (WasX$)
  3454.       IF NOT ZOK THEN _
  3455.          GOTO 10986
  3456.       ZFileName$ = ZOutTxt$(3)
  3457.       ExitMethod$ = ZOutTxt$(4)
  3458.       ExitTemplate$ = ZOutTxt$(5)
  3459.       ZDoorDisplay$ = ZOutTxt$(7)
  3460.       DoorTime$ = ZOutTxt$(8)
  3461.       CALL AskUsers
  3462.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  3463.       CALL MetaGSR (ExitTemplate$,ZFalse)
  3464.       ExitTo$ = ExitTemplate$
  3465.       GOTO 10989
  3466. 10986 ZOutTxt$ = "Missing door program"
  3467.       CALL UpdtCalr (ZOutTxt$ + " " + ZWasZ$,1)
  3468.       ZSnoop = ZTrue
  3469.       CALL LPrnt (ZOutTxt$,1)
  3470.       EXIT SUB
  3471. 10989 IF ZTransferFunction = 3 THEN _
  3472.          ZWasY$ = "Registration" _
  3473.       ELSE ZWasY$ = ZDooredTo$
  3474.       ZOutTxt$ = ZWasY$ + _
  3475.            " door opened at " + _
  3476.            TIME$ + _
  3477.            " on " + _
  3478.            DATE$
  3479.       ZSubParm = 5
  3480.       CALL TPut
  3481.       CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
  3482.       CLOSE 2
  3483.       OPEN "O",2,"DORINFO" + _
  3484.                  ZNodeFileID$ + _
  3485.                  ".DEF"
  3486.       PRINT #2,ZRBBSName$
  3487.       PRINT #2,ZSysopFirstName$
  3488.       PRINT #2,ZSysopLastName$
  3489.       IF ZLocalUser THEN _
  3490.          PRINT #2,"COM0" _
  3491.       ELSE PRINT #2,ZComPort$
  3492.       ZUserIn$ = MID$(ZBaudParity$,4+INSTR(ZBaudParity$," B"))
  3493.       PRINT #2,ZTalkToModemAt$;" BAUD";ZUserIn$
  3494.       PRINT #2,ZNetworkType
  3495.       IF ZGlobalSysop THEN _
  3496.          PRINT #2,"SYSOP" : _
  3497.          PRINT #2,"" _
  3498.       ELSE PRINT #2,ZFirstName$ : _
  3499.            PRINT #2,ZLastName$
  3500.       PRINT #2,ZCityState$
  3501.       PRINT #2,ZWasGR
  3502.       PRINT #2,ZUserSecLevel
  3503.       CALL TimeRemain (MinsRemaining)
  3504.       CALL CheckInt (DoorTime$)
  3505.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  3506.          IF MinsRemaining > ZTestedIntValue THEN _
  3507.             MinsRemaining = ZTestedIntValue
  3508.       PRINT #2,INT(MinsRemaining)
  3509.       PRINT #2,ZFossil
  3510.       CLOSE 2
  3511.       IF ExitMethod$ = "S" THEN _
  3512.          CALL UpdateU (ZFalse) : _
  3513.          CLOSE 4,5 : _
  3514.          CALL ShellExit (ExitTemplate$) : _
  3515.          ZPrevCaller$ = "" : _
  3516.          CALL SetCall : _
  3517.          ZExitToDoors = ZTrue : _
  3518.          CALL DoorReturn : _
  3519.          CALL BufFile (ZDoorDisplay$,WasX) : _
  3520.          ZExitToDoors = ZFalse _
  3521.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  3522.                   "COMMAND /C " + _
  3523.                   ExitTo$ : _
  3524.            ZOutTxt$(2) = ZRBBSBat$ : _
  3525.            CALL RBBSExit (ZOutTxt$(),2)
  3526.       END SUB
  3527. 10992 ' $SUBTITLE: 'RBBSExit -- Setup to exit RBBS'
  3528. ' $PAGE
  3529. '  NAME    -- RBBSExit
  3530. '
  3531. '  INPUTS  -- PARAMETER             MEANING
  3532. '             LINE.ARA        Array of lines to write to batch file
  3533. '             NumLines        How many lines in array
  3534. '
  3535. '  OUTPUTS -- ZRCTTYBat$
  3536. '
  3537. '  PURPOSE -- To create a batch file that control can be passed to
  3538. '             and to exit RBBS-PC while still keeping carrier up
  3539. '
  3540.       SUB RBBSExit (LineAra$(1),NumLines) STATIC
  3541.       CLOSE 2
  3542.       IF NumLines = 0 THEN _
  3543.          GOTO 10994
  3544.       OPEN "O",2,ZRCTTYBat$
  3545.       FOR WasI = 1 TO NumLines
  3546.          IF LineAra$(WasI) <> "" THEN _
  3547.             PRINT #2,LineAra$(WasI)
  3548.       NEXT
  3549.       CLOSE 2
  3550. 10994 CLOSE 3
  3551.       ZExitToDoors = ZTrue
  3552.       IF NOT ZFossil THEN _
  3553.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  3554.       IF NOT ZPrivateDoor THEN _
  3555.          CALL MLInit (2)
  3556. 10996 CALL UpdateU (ZTrue)
  3557.       CALL GetTime
  3558.       CALL SaveProf (1)
  3559.       IF NumLines = 0 THEN _
  3560.          EXIT SUB
  3561.       CALL DelayTime (9 + ZBPS)
  3562.       IF ZFossil THEN _
  3563.          CALL FOSExit(ZComPort)
  3564.       SYSTEM
  3565.       END SUB
  3566. 12000 ' $SUBTITLE: 'SetSection -- Setup section prompts'
  3567. ' $PAGE
  3568. '  NAME    -- SetSection         Doug Azzarito
  3569. '
  3570. '  INPUTS  -- PARAMETER             MEANING
  3571. '             ZMenuIndex      2 = user is in MAIN section
  3572. '                             3 = user is in FILE section
  3573. '                             4 = user is in UTIL section
  3574. '                             6 = user is in LIBR section
  3575. '
  3576. '  OUTPUTS -- ZSection$       4 character section name
  3577. '             ZActiveMenu$    1 character section name
  3578. '             ZSectionPrompt$ Section name (if ZShowSection config)
  3579. '             ZCmdPrompt$     Command input prompt string
  3580. '             ZSectionOpts$   List of options valid in this sect
  3581. '             ZInvalidOpts$   List of options invalid in this sect
  3582. '             ZSubSection     Index into security array for section
  3583. '
  3584. '  PURPOSE -- To build the prompt strings for the current section
  3585. '
  3586.       SUB SetSection STATIC
  3587.       IF ZMenuIndex <> 6 THEN _
  3588.          ZCurDirPath$ = ZDirPath$
  3589.       ON ZMenuIndex GOTO 12001, 12010,12005,12020,12001,12015
  3590. 12001 EXIT SUB
  3591. 12005 LSET ZSection$ = "FILE"
  3592.       ZSectionOpts$ = ZFileOpts$
  3593.       ZInvalidOpts$ = ZInvalidFileOpts$
  3594.       ZSubSection = ZBegFile
  3595.       GOTO 12025
  3596. 12010 LSET ZSection$ = "MAIN"
  3597.       ZSectionOpts$ = ZMainOpts$
  3598.       ZInvalidOpts$ = ZInvalidMainOpts$
  3599.       ZSubSection = ZBegMain
  3600.       GOTO 12025
  3601. 12015 LSET ZSection$ = "LIBR"
  3602.       ZSectionOpts$ = ZLibOpts$
  3603.       ZInvalidOpts$ = ZInvalidLibraryOpts$
  3604.       ZSubSection = ZBegLibrary
  3605.       ZCurDirPath$ = ZLibDirPath$
  3606.       GOTO 12025
  3607. 12020 LSET ZSection$ = "UTIL"
  3608.       ZSectionOpts$ = ZUtilOpts$
  3609.       ZInvalidOpts$ = ZInvalidUtilOpts$
  3610.       ZSubSection = ZBegUtil
  3611. 12025 ZActiveMenu$ = LEFT$(ZSection$,1)
  3612.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  3613.       IF ZShowSection THEN _
  3614.          ZSectionPrompt$ = ZSection$ _
  3615.       ELSE ZSectionPrompt$ = "Your"
  3616.       IF ZCmndsInPrompt=0 THEN _
  3617.           ZSectionOpts$ = ""
  3618.       ZCmdPrompt$ = ZSectionPrompt$ + _
  3619.                         " command" + _
  3620.                         ZSectionOpts$
  3621.       END SUB
  3622. 12878 ' $SUBTITLE: 'UntilRight - asks question until answer okay'
  3623. ' $PAGE
  3624. '
  3625. '  NAME    -- UntilRight
  3626. '
  3627. '  INPUTS  -- PARAMETER             MEANING
  3628. '             Ques$         QUESTION TO BE ASKED THE USER
  3629. '             Ans$          LOCATION TO STORE THE ANSWER
  3630. '             MinLen        MINIMUM LENGTH OF ANSWER
  3631. '             MaxLen        MAX LENGTH OF ANSWER
  3632. '
  3633. '  OUTPUTS -- Ans$          RESPONSE TO THE QUESTION WHICH THE
  3634. '                                      CALLERS SAYS IS CORRECT
  3635. '
  3636. '  PURPOSE -- Subroutine to ask a user a question until the caller
  3637. '             responds that the answer is correct
  3638. '
  3639.       SUB UntilRight (Ques$,Ans$,MinLen,MaxLen) STATIC
  3640. 12880 ZParseOff = ZTrue
  3641.       ZOutTxt$ = Ques$
  3642.       CALL PopCmdStack
  3643.       IF ZSubParm = -1 THEN _
  3644.          GOTO 12882
  3645.       IF ZWasQ = 0 THEN _
  3646.          GOTO 12880
  3647.       IF LEN(ZUserIn$(ZAnsIndex)) > MaxLen THEN _
  3648.          ZLastIndex = 0 : _
  3649.          CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _
  3650.          GOTO 12880_
  3651.       ELSE IF LEN(ZUserIn$(ZAnsIndex)) < MinLen THEN _
  3652.               ZLastIndex = 0 : _
  3653.               CALL QuickTPut1 (STR$(MinLen) + " chars min") : _
  3654.               GOTO 12880
  3655.       Ans$ = ZUserIn$(ZAnsIndex)
  3656.       IF ZAnsIndex < ZLastIndex THEN _
  3657.          GOTO 12881
  3658.       ZOutTxt$ = ZUserIn$(ZAnsIndex) + _
  3659.            ", right ([Y],N)"
  3660.       ZTurboKey = -ZTurboKeyUser
  3661.       ZSubParm = 1
  3662.       CALL TGet
  3663.       IF ZSubParm = -1 THEN _
  3664.          GOTO 12882
  3665.       IF ZNo THEN _
  3666.          GOTO 12880
  3667. 12881 CALL AllCaps (Ans$)
  3668.       EXIT SUB
  3669. 12882 Ans$ = "GUEST"
  3670.       END SUB
  3671. 13660 ' $SUBTITLE: 'LogError - sub to log errors to CALLERS file'
  3672. ' $PAGE
  3673. '
  3674. '  NAME    -- LogError
  3675. '
  3676. '  INPUTS  --     PARAMETER                    MEANING
  3677. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  3678. '                    ERL           Last LINE NUMBER ENCOUNTERED
  3679. '                                  PRIOR TO ENCOUNTERNING ERROR
  3680. '
  3681. '  OUTPUTS -- NONE
  3682. '
  3683. '  PURPOSE -- To set up a string to write to the callers log
  3684. '             indicating the date, time, error, and error line
  3685. '
  3686.       SUB LogError STATIC
  3687.       WasIX = ERR
  3688.       IF ERR < 1 THEN _
  3689.          WasIX = ZErrCode
  3690.       CALL UpdtCalr("+++ Error " + _
  3691.            STR$(WasIX) + _
  3692.            " line " + _
  3693.            STR$(ERL) + _
  3694.            " at " + _
  3695.            TIME$ + _
  3696.            " on " + _
  3697.            DATE$,2)
  3698.       END SUB
  3699. '
  3700. 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
  3701. ' $PAGE
  3702. '
  3703. '  NAME    -- CheckRatio
  3704. '
  3705. '  INPUTS  --   PARAMETER                    MEANING
  3706. '               TellUser           TELL USER THEIR RATIO
  3707. '               ZDnlds             FILES DOWNLOADED
  3708. '               ZDLBytes!          BYTES DOWNLOADED
  3709. '               ZUplds             FILES UPLOADED
  3710. '               ZULBytes!          BYTES UPLOADED
  3711. '
  3712. '  OUTPUTS --   ZOK                 -1 if okay to download, 0 otherwise
  3713. '
  3714. '  PURPOSE -- To determine whether the users violated
  3715. '             their upload to download restriction
  3716. '
  3717.       SUB CheckRatio (TellUser) STATIC
  3718.       ZOK = ZTrue
  3719.       IF NOT ZEnforceRatios THEN _
  3720.          GOTO 20110
  3721.       IF ZRatioRestrict# <= 0 THEN _
  3722.          GOTO 20110
  3723. '
  3724. ' Detemine method of ratio checking.  Look ahead to amount downloaded
  3725. '
  3726.       IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
  3727.          Method$ = "Bytes" : _
  3728.          ULWork# = ZULBytes! : _
  3729.          DLWork# = ZDLBytes! + ZNumDnldBytes!
  3730.       IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
  3731.          Method$ = "Files" : _
  3732.          ULWork# = ZUplds : _
  3733.          DLWork# = ZDnlds + ZDownFiles
  3734.       IF ULWork# < ZInitialCredit# THEN _
  3735.          ULWork# = ZInitialCredit#
  3736.       IF ZByteMethod = 2 THEN _
  3737.          Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
  3738.       IF ZByteMethod = 3 THEN _
  3739.          Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
  3740. '
  3741.       Ratio# = 0
  3742.       RatioSuffix$ = ":0"
  3743.       IF ULWork# > 0 THEN _
  3744.          Ratio# = (DLWork# / ULWork#) : _
  3745.          RatioSuffix$ = ":1"
  3746.       IF ZByteMethod > 1 THEN _
  3747.          ZOutTxt$ = "Today Downloaded Files: " + STR$(ZDLToday! + ZDownFiles) + _
  3748.               "  Bytes:" + STR$(ZBytesToday! + ZNumDnldBytes!) : _
  3749.          ZSubParm = 5 : _
  3750.          CALL TPut : _
  3751.          CALL SkipLine (1) : _
  3752.          GOTO 20100
  3753.       WasX$ = STR$(Ratio#)
  3754.       X = INSTR(WasX$,".")
  3755.       IF X > 0 THEN _
  3756.          WasX$ = LEFT$(WasX$,X+1)
  3757.       ZOutTxt$ = Method$ + " Downloaded:" + STR$(DLWork#) + _
  3758.               " Uploaded:" + _
  3759.               STR$(ULWork#) + _
  3760.               " Ratio:" + _
  3761.               WasX$ + _
  3762.               RatioSuffix$
  3763.       ZSubParm = 5
  3764.       CALL TPut
  3765. '
  3766. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3767. '
  3768. 20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
  3769.          EXIT SUB
  3770.       IF ZByteMethod <= 1 THEN _
  3771.          GOTO 20105
  3772.       IF Today# < 0 THEN _
  3773.          ZOutTxt$ = "Sorry, Daily download limit of" + _
  3774.               STR$(ZRatioRestrict#) + " " + _
  3775.               Method$ + " Reached" : _
  3776.          ZOK = ZFalse _
  3777.       ELSE ZOutTxt$ = "Download balance:" + _
  3778.                 STR$(Today#) + _
  3779.                 " " + _
  3780.                 Method$ : _
  3781.            ZOK = ZTrue
  3782.       ZSubParm = 5
  3783.       CALL TPut
  3784.       CALL SkipLine(1)
  3785.       EXIT SUB
  3786. '
  3787. 20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
  3788.          ZOK = ZFalse : _
  3789.          ZOutTxt$ = "Sorry, DL/UL ratio of" + _
  3790.               STR$(ZRatioRestrict#) + _
  3791.               ":1 " + _
  3792.               Method$ + " exceeded" : _
  3793.          ZSubParm = 5 : _
  3794.          CALL TPut : _
  3795.          ZOutTxt$ = "Minimum upload of" + _
  3796.               STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
  3797.               / ZRatioRestrict#) + 1)) + _
  3798.               + " " + Method$ + " required to download" _
  3799.       ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
  3800.                 STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
  3801.                 " " + Method$
  3802.       ZSubParm = 5
  3803.       CALL TPut
  3804.       CALL SkipLine (1)
  3805. 20110 END SUB
  3806. 20140 ' $SUBTITLE: 'GetArc - sub to get what files to verbose list'
  3807. ' $PAGE
  3808. '
  3809. '  NAME    -- GetArc
  3810. '
  3811. '  INPUTS  --     PARAMETER                    MEANING
  3812. '                 ZWasQ                       NUMBER OF ENTRIES TYPED
  3813. '                 ZUserIn$()                  ENTRIES TYPED
  3814. '
  3815. '  OUTPUTS --
  3816. '
  3817. '  PURPOSE --  Process the V)erbose list command.
  3818. '              Takes what user types and tries to list it.
  3819. '
  3820.       SUB GetArc STATIC
  3821. 20141 IF ZAnsIndex >= ZLastIndex THEN _
  3822.          IF LEN(ZDefaultExtension$) > 0 THEN _
  3823.             CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$)
  3824.       ZOutTxt$ = "What compressed file(s)" + ZPressEnterExpert$
  3825.       CALL PopCmdStack
  3826.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3827.          EXIT SUB
  3828. 20142 ZViolation$ = "View ARC"
  3829.       WasX = ZAnsIndex
  3830.       FOR ZAnsIndex = WasX TO ZLastIndex
  3831.          GOSUB 20143
  3832.          IF ZSubParm < 0 THEN _
  3833.             ZAnsIndex = ZLastIndex + 1
  3834.       NEXT
  3835.       IF ZLastIndex > 1 THEN _
  3836.          EXIT SUB _
  3837.       ELSE GOTO 20141
  3838. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  3839.       WasZ$ = ZWasZ$
  3840.       CALL AllCaps (ZWasZ$)
  3841.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  3842.       IF Ext$ = "" THEN _
  3843.          Ext$ = ZDefaultExtension$ : _
  3844.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  3845.       ZFileNameHold$ = ZWasZ$
  3846.       ZFileName$ = ZWasZ$
  3847.       CALL BadFile (Prefix$,BadFileNameIndex)
  3848.       ON BadFileNameIndex GOTO 20144,20146,20147
  3849. 20144 CALL BadFile (ZFileName$,BadFileNameIndex)
  3850.       ON BadFileNameIndex GOTO 20145,20146,20147
  3851. 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V")
  3852.       IF ZOK THEN _
  3853.          GOTO 20148
  3854. 20146 ZWasZ$ = WasZ$ + _
  3855.            " not found!"
  3856.       CALL UpdtCalr (ZWasZ$,2)
  3857.       ZOutTxt$ = ZWasZ$ + _
  3858.            " Type correct filename" + ZPressEnterExpert$
  3859.       ZSubParm = 1
  3860.       CALL TGet
  3861.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3862.          RETURN
  3863.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  3864.       GOTO 20143
  3865. 20147 CALL SecViolation
  3866.       IF ZDenyAccess THEN _
  3867.          EXIT SUB
  3868.       GOTO 20146
  3869. 20148 WasX$ = ZDiskForDos$ + "V" + Ext$ + ".BAT"
  3870.       CALL FindIt (WasX$)
  3871.       IF NOT ZOK THEN _
  3872.          GOTO 20150
  3873.       ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  3874.       CALL ReadDir (2,1)
  3875.       IF EOF(2) THEN _
  3876.          ZWasZ$ = ZOutTxt$ : _
  3877.          ZGSRAra$(1) = ZFileName$ : _
  3878.          ZGSRAra$(2) = ZArcWork$ _
  3879.       ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  3880.                 " " + ZArcWork$ + " " + ZGSRAra$(3)
  3881.       CALL ShellExit (ZWasZ$)
  3882.       CALL BufFile (ZArcWork$,WasX)
  3883.       RETURN
  3884. 20150 WasX = INSTR(".ARC.PAK.ZIP.LZH.","."+Ext$+".")
  3885.       'IF (WasX < 1) OR (WasX = 1 AND NOT ZTurboRBBS) THEN _
  3886.       IF (WasX < 1) THEN _
  3887.          CALL QuickTPut1 ("View for "+Ext$+" not implemented") : _
  3888.          RETURN
  3889.       CALL QuickTPut1 (ZFileNameHold$ + " has these files")
  3890.       CALL ViewArc
  3891.       RETURN
  3892.       END SUB
  3893. 20235 ' $SUBTITLE: 'BadName - subroutine to find bad file names'
  3894. ' $PAGE
  3895. '
  3896. '  NAME    -- BadName
  3897. '
  3898. '  INPUTS  --     PARAMETER                    MEANING
  3899. '               ZActiveMessageFile$
  3900. '               ZActiveUserFile$
  3901. '               ZCallersFile$
  3902. '               ZCmntsFile$
  3903. '               CONFIG.FILEANAME$
  3904. '               ZMainMsgBackup$
  3905. '               ZMainMsgFile$
  3906. '               ZMaxViolations
  3907. '               ZPswdFile$
  3908. '               ZRBBSBat$
  3909. '               ZRCTTYBat$
  3910. '               ZSubDir$()
  3911. '               ZSubDirIndex
  3912. '               ZViolation$
  3913. '               ZViolationsThisSession
  3914. '               ZWasZ$                          NAME OF FILE
  3915. '               ProtectExt              -1 if check for extension alone
  3916. '                                        0 to allow any extension
  3917. '
  3918. '  OUTPUTS  -- BadFileNameIndex         1 = FILE NAME IS OK
  3919. '                                       2 = SECURITY BREACH TRIED
  3920. '
  3921. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  3922. '             to either crash the system or to breach RBBS-PC's security
  3923. '
  3924.       SUB BadName (BadFileNameIndex,ProtectExt) STATIC
  3925. '
  3926. '
  3927. ' *  TEST FOR SYSTEM FILE ATTEMPT
  3928. '
  3929.       BadFileNameIndex = 2
  3930.       ZWasZ$ = ZFileName$
  3931.       CALL BreakFileName (ZFileName$,DR$,Prefix$,Extension$,ZFalse)
  3932.       IF LEN(Extension$) = 3 AND ProtectExt THEN _
  3933.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",Extension$+",") > 0 THEN _
  3934.             EXIT SUB
  3935.       ZOK = 0
  3936.       IF ProtectExt THEN _
  3937.          CALL FileNameCheck (ZActiveMessageFile$,Prefix$,Extension$)
  3938.       CALL FileNameCheck (ZActiveUserFile$,Prefix$,Extension$)
  3939.       CALL FileNameCheck (ZCallersFile$,Prefix$,Extension$)
  3940.       CALL FileNameCheck (ZCmntsFile$,Prefix$,Extension$)
  3941.       CALL FileNameCheck (ZFileSecFile$,Prefix$,Extension$)
  3942.       CALL FileNameCheck (ZMainMsgBackup$,Prefix$,Extension$)
  3943.       CALL FileNameCheck (ZOrigMsgFile$,Prefix$,Extension$)
  3944.       CALL FileNameCheck (ZOrigUserFile$,Prefix$,Extension$)
  3945.       CALL FileNameCheck (ZPswdFile$,Prefix$,Extension$)
  3946.       CALL FileNameCheck (ZRBBSBat$,Prefix$,Extension$)
  3947.       CALL FileNameCheck (ZRCTTYBat$,Prefix$,Extension$)
  3948.       CALL FileNameCheck (ZConfigFileName$,Prefix$,Extension$)
  3949.       IF ZOK = 0 THEN _
  3950.          BadFileNameIndex = 1
  3951.       END SUB
  3952. 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
  3953. ' $PAGE
  3954. '
  3955. '  NAME    -- FileNameCheck
  3956. '
  3957. '  INPUTS  --     PARAMETER                    MEANING
  3958. '               CheckThis$           Name of file to check
  3959. '               Pref2$               Prefix to match against
  3960. '               Ext2$                Extension to match against
  3961. '
  3962. '  OUTPUTS  -- ZOK                    1 if got match
  3963. '
  3964. '  PURPOSE -- Checks for match on both prefix and extension of a file
  3965. '             name.   Used to catch match on system files not to be
  3966. '             downloaded.
  3967. '
  3968.       SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
  3969.       IF ZOK > 0 THEN _
  3970.          EXIT SUB
  3971.       CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
  3972.       IF Pref1$ = Pref2$ THEN _
  3973.          IF Ext1$ = Ext2$ THEN _
  3974.             ZOK = 1
  3975.       END SUB
  3976.  
  3977.